# -----------------------------------------------------------------
# App Title: Performance of Wilcoxon-Mann-Whitney Test and t-test
#    Author: Jimmy Wong
# -----------------------------------------------------------------

if (!require("ggplot2")) install.packages("ggplot2")
if (!require("gridExtra")) install.packages("gridExtra")
if (!require("googleVis")) install.packages("googleVis")
if (!require("shinyBS")) install.packages("shinyBS")
if (!require("shinyIncubator")) install.packages("shinyIncubator")

shinyUI(fluidPage(
  tags$head(tags$link(rel = "icon", type = "image/x-icon",
                      href = "https://webresource.its.calpoly.edu/cpwebtemplate/5.0.1/common/images_html/favicon.ico")),

  titlePanel("Performance of Wilcoxon-Mann-Whitney Test and t-test"),

  tabsetPanel(type="tabs",
              tabPanel("Goal of Study",
                       column(1),
                       column(4,
                              br(),br(),
                              p("This study compares the", span("Type I error rate",style = "color:red"), "and", span("power",style = "color:blue"),
                                "between the two-sample t-test and the Wilcoxon-Mann-Whitney (WMW) test. The", strong("two-sample t-test"), "requires either the
                                two population distributions to be normal or the sample sizes to be large enough in order for the sampling distribution
                                to be normal.  The", strong("WMW test"), "is a nonparametric test that requires the two population distributions to have the same shape.
                                When two populations have the same mean, Type I error rate is of interest.  In contrast, when two populations have different
                                means, power is of interest"),
                              p("Different scenarios are analyzed in this study, such as comparing two Normal distributions, a Normal to a Gamma distribution, and two Gamma
                                distributions with small and large sample sizes.  The better test is determined either through a lower Type I error rate or a higher power.")),
                       column(6,
                              plotOutput("intrograph"),br(),
                              bsPopover("intrograph", "Note","These 4 graphs provide sample scenarios. In each of these sample scenarios, would you focus on Type I error rate or power?",
                                        placement="left",trigger="hover"),
                              div("Shiny app by",
                                  a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                              div("Base R code by",
                                  a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                              div("Shiny source files:",
                                  a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                    target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                              div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                    "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")),
                       column(1)),

              tabPanel("Guess the Population!",
                       column(1),
                       column(4,
                              br(),
                              p("It is time to", strong("Guess the Population!"), "This game demonstrates the difficulty of identifying which
                                pair of sample data are from the same population. Below are 4 histograms of randomly generated data with sample
                                sizes of 20, where 2 are from", code("N(3,1)"), "(Normal distribution) and 2 are from", code("Gamma(6,.5)"), "(Gamma distribution)."),
                              div("Can you determine which pair came from the Normal distribution and which pair from the Gamma distribution?",style = "color:navy"),
                              tags$hr(),
                              uiOutput("answerinsert"),
                              uiOutput("answercheck"),br(),
                              uiOutput("answerreveal"),
                              conditionalPanel(
                                condition="input.reveal",
                                tableOutput("answer"))),
                       column(6,
                              plotOutput("guesspop"),
                              actionButton("resetgame", "Reset game"),
                              div("Shiny app by",
                                  a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                              div("Base R code by",
                                  a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                              div("Shiny source files:",
                                  a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                    target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                              div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                    "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")),
                       column(1)),

              navbarMenu("Two Normal Populations",
                                   tabPanel("Single comparison",
                                            fluidPage(
                                              absolutePanel(
                                                right=110,width=220,draggable=TRUE,cursor="move",
                                                wellPanel(
                                                  h5("Normal distribution 1:"),
                                                  sliderInput("nnorm1","Sample size:",min=10,max=100,step=10,value=20),
                                                  numericInput("meannorm1","Mean:",value=3),
                                                  tags$hr(),
                                                  h5("Normal distribution 2:"),
                                                  sliderInput("nnorm2","Sample size:",min=10,max=100,step=10,value=20),
                                                  numericInput("meannorm2","Mean:",value=4),
                                                  tags$hr(),
                                                  sliderInput("alpha1",HTML("Significance level α:"),min=.01,max=1,step=.01,value=.05),
                                                  sliderInput("nsim1","Number of simulations:",min=10,max=1000,value=50,step=10),br(),
                                                  actionButton("start1","Start simulation!"),
                                                  br(),br(),br(),
                                                  div("Shiny app by",
                                                      a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                                  div("Base R code by",
                                                      a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                                  div("Shiny source files:",
                                                      a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                                        target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                                                  div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                                        "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt"))),
                                              column(8,
                                                     bsCollapse(multiple=TRUE, open=c("normnorm1","normnorm2","normcond"), id="normalcollapse",
                                                                bsCollapsePanel("Population Distributions", id="normnorm1",
                                                                                bsPopover("normnorm1","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                                plotOutput("twonormplots"),
                                                                                uiOutput("normselected"),
                                                                                p("Note:"),
                                                                                HTML("

 Variances are fixed at 1

 P(rejecting Ho | μ1=μ2) = Type I error rate

 P(rejecting Ho | μ1≠μ2) = Power

"), br(),
                                                                                conditionalPanel(
                                                                                condition="input.meannorm1==input.meannorm2",
                                                                                div("These two Normal distributions have the same means; focus on", code("Type I error rate"),
                                                                                style = "color:navy")),
                                                                                conditionalPanel(
                                                                                condition="input.meannorm1!=input.meannorm2",
                                                                                div("These two Normal distributions have different means; focus on", code("Power"),
                                                                                style = "color:navy"))),
                                                                bsCollapsePanel("Conditions", id="normcond",
                                                                                bsPopover("normcond","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                                uiOutput("satisfied1")),
                                                                bsCollapsePanel("Simulation Results", id="normnorm2",
                                                                                conditionalPanel(
                                                                                condition="input.start1>0",
                                                                                bsPopover("normnorm2","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                                plotOutput("twohistnorms"),
                                                                                column(3,
                                                                                #tableOutput("table1"),
                                                                                conditionalPanel(
                                                                                condition="input.meannorm1==input.meannorm2",
                                                                                strong("Type I error rate:")),
                                                                                conditionalPanel(
                                                                                condition="input.meannorm1!=input.meannorm2",
                                                                                strong("Power:")),
                                                                                htmlOutput("gauge1")),
                                                                                column(4,
                                                                                br(),br(),
                                                                                uiOutput("text1")))))),
                                              column(4))),

                                   tabPanel("Comparison over a range",
                                            fluidPage(
                                              absolutePanel(
                                                right=110,width=220,draggable=TRUE,cursor="move",
                                                     wellPanel(
                                                       h5("Normal distribution 1:"),
                                                       sliderInput("nnorm11","Sample size:",min=10,max=100,step=10,value=20),
                                                       sliderInput("varymeans1","Range of means:",min=-10,max=10,step=1,value=c(0,6)),
                                                       tags$hr(),
                                                       h5("Normal distribution 2:"),
                                                       sliderInput("nnorm21","Sample size:",min=10,max=100,step=10,value=20),
                                                       sliderInput("meannorm21","Mean:",min=-10,max=10,step=1,value=3),
                                                       tags$hr(),
                                                       sliderInput("alpha11",HTML("Significance level α:"),min=.01,max=1,step=.01,value=.05),
                                                       sliderInput("nsim11","Number of simulations:",min=10,max=200,value=50,step=10),br(),
                                                       actionButton("start11","Start simulation!"),
                                                       br(),br(),br(),
                                                       div("Shiny app by",
                                                           a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                                       div("Base R code by",
                                                           a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                                       div("Shiny source files:",
                                                           a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                                             target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                                                       div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                                             "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt"))),
                                              column(8,
                                                     bsCollapse(multiple=TRUE, open=c("c11","c12"), id="normalvarycollapse",
                                                                bsCollapsePanel("Simulation Information", id="c11",
                                                                                bsPopover("c11","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                                span("In this scenario, the mean of the 1st Normal distribution varies according to the specified range, while the mean of the
                                                                                2nd Normal distribution remains constant.  The Type 1 error rate and power is compared between the t-test and the WMW test.",
                                                                                style = "color:black")),
                                                                bsCollapsePanel("Simulation Results", id="c12",
                                                                                p("In the generated graph, each point is either a Type I error rate or power;
                                                                                there is at most 1 Type I error rate (when the two population means are the same)."),
                                                                                conditionalPanel(
                                                                                condition="input.start11>0",
                                                                                bsPopover("c12","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                                htmlOutput("graph.norm"))))),
                                              column(4)))),

              navbarMenu("Normal and Gamma Populations",
                         tabPanel("Single comparison",
                                  fluidPage(
                                    absolutePanel(
                                      right=110,width=220,draggable=TRUE,cursor="move",
                                      wellPanel(
                                        h5("Normal distribution:"),
                                        sliderInput("nnorm3","Sample size:",min=10,max=100,step=10,value=10),
                                        numericInput("meannorm3","Mean:",value=3),
                                        tags$hr(),
                                        h5("Gamma distribution:"),
                                        sliderInput("ngam1","Sample size:",min=10,max=100,step=10,value=10),
                                        sliderInput("shape1","Shape:",min=.5,max=20,step=.5,value=8),
                                        sliderInput("scale1","Scale:",min=.5,max=10,step=.5,value=.5),
                                        tags$hr(),
                                        sliderInput("alpha2",HTML("Significance level α:"),min=.01,max=1,step=.01,value=.05),
                                        sliderInput("nsim2","Number of simulations:",min=10,max=1000,value=50,step=10),br(),
                                        actionButton("start2","Start simulation!"),
                                        br(),br(),br(),
                                        div("Shiny app by",
                                            a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                        div("Base R code by",
                                            a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                        div("Shiny source files:",
                                            a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                              target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                                        div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                              "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt"))),
                                    column(8,
                                           bsCollapse(multiple=TRUE, open=c("normgam1","normgam2","normgamcond"), id="normgamcollapse",
                                                      bsCollapsePanel("Population Distributions", id="normgam1",
                                                                      bsPopover("normgam1","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                      plotOutput("twonormgamplots"),
                                                                      uiOutput("normgamselected"),
                                                                      p("Note:"),
                                                                      HTML("

 Variance of Normal is fixed at 1

 Gamma mean is the product of shape and scale

 P(rejecting Ho | μ1=μ2) = Type I error rate

 P(rejecting Ho | μ1≠μ2) = Power

"),br(),
                                                                      uiOutput("focusinfo1")),
                                                      bsCollapsePanel("Conditions", id="normgamcond",
                                                                      bsPopover("normgamcond","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                      uiOutput("satisfied2")),
                                                      bsCollapsePanel("Simulation Results", id="normgam2",
                                                                      conditionalPanel(
                                                                        condition="input.start2>0",
                                                                        bsPopover("normgam2","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                        plotOutput("twohistnormgams"),
                                                                        column(3,
                                                                               #tableOutput("table2"),
                                                                               uiOutput("whichone"),
                                                                               htmlOutput("gauge2")),
                                                                        column(4,
                                                                               br(),br(),
                                                                               uiOutput("text2")))))),
                                    column(4))),
                         tabPanel("Comparison over a range",
                                  fluidPage(
                                    absolutePanel(
                                      right=110,width=220,draggable=TRUE,cursor="move",
                                           wellPanel(
                                             h5("Normal distribution:"),
                                             sliderInput("nnorm31","Sample size:",min=10,max=100,step=10,value=20),
                                             sliderInput("varymeans2","Range of means:",min=0,max=50,step=1,value=c(0,6)),
                                             tags$hr(),
                                             h5("Gamma distribution:"),
                                             sliderInput("ngam11","Sample size:",min=10,max=100,step=10,value=20),
                                             sliderInput("shape11","Shape:",min=.5,max=10,step=.5,value=6),
                                             sliderInput("scale11","Scale:",min=.5,max=2.5,step=.5,value=.5),
                                             tags$hr(),
                                             sliderInput("alpha21",HTML("Significance level α:"),min=.01,max=1,step=.01,value=.05),
                                             sliderInput("nsim21","Number of simulations:",min=10,max=200,value=50,step=10),br(),
                                             actionButton("start21","Start simulation!"),
                                             br(),br(),br(),
                                             div("Shiny app by",
                                                 a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                             div("Base R code by",
                                                 a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                             div("Shiny source files:",
                                                 a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                                   target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                                             div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                                   "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt"))),
                                    column(8,
                                           bsCollapse(multiple=TRUE, open=c("c21","c22"), id="normalvarycollapse",
                                                      bsCollapsePanel("Simulation Information", id="c21",
                                                                      bsPopover("c21","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                      span("In this scenario, the mean of the Normal distribution varies according to the specified range, while the mean of the
                                                                           Gamma distribution remains constant.  The Type 1 error rate and power is compared between the t-test and the WMW test.",
                                                                           style = "color:black")),
                                                      bsCollapsePanel("Simulation Results", id="c22",
                                                                      p("In the generated graph, each point is either a Type I error rate or power;
                                                                        there is at most 1 Type I error rate (when the two population means are the same)."),
                                                                      conditionalPanel(
                                                                        condition="input.start21>0",
                                                                        bsPopover("c22","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                        htmlOutput("graph.normgam"))))),
                                    column(4)))),

              navbarMenu("Two Gamma Populations",
                         tabPanel("Single comparison",
                                  fluidPage(
                                    absolutePanel(
                                      right=110,width=220,draggable=TRUE,cursor="move",
                                      wellPanel(
                                        h5("Gamma distribution 1:"),
                                        sliderInput("ngam2","Sample size:",min=10,max=100,step=10,value=10),
                                        sliderInput("shape2","Shape:",min=.5,max=20,step=.5,value=6),
                                        sliderInput("scale2","Scale:",min=.5,max=10,step=.5,value=.5),
                                        tags$hr(),
                                        h5("Gamma distribution 2:"),
                                        sliderInput("ngam3","Sample size:",min=10,max=100,step=10,value=10),br(),
                                        sliderInput("far1","Distance from first Gamma:",min=0,max=100,step=1,value=3),
                                        tags$hr(),
                                        sliderInput("alpha3",HTML("Significance level α:"),min=.01,max=1,step=.01,value=.05),
                                        sliderInput("nsim3","Number of simulations:",min=10,max=1000,value=50,step=10),br(),
                                        actionButton("start3","Start simulation!"),
                                        br(),br(),br(),
                                        div("Shiny app by",
                                            a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                        div("Base R code by",
                                            a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                        div("Shiny source files:",
                                            a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                              target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                                        div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                              "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt"))),
                                    column(8,
                                           bsCollapse(multiple=TRUE, open=c("gamgam1","gamgam2","gamcond"), id="gamgamcollapse",
                                                      bsCollapsePanel("Population Distributions", id="gamgam1",
                                                                      bsPopover("gamgam1","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                      plotOutput("twogamplots"),
                                                                      uiOutput("gamselected"),
                                                                      p("Note:"),
                                                                      HTML("

 Gamma mean is the product of shape and scale

 P(rejecting Ho | μ1=μ2) = Type I error rate

 P(rejecting Ho | μ1≠μ2) = Power

"),br(),
                                                                      uiOutput("focusinfo2")),
                                                      bsCollapsePanel("Conditions", id="gamcond",
                                                                      bsPopover("gamcond","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                      uiOutput("satisfied3")),
                                                      bsCollapsePanel("Simulation Results", id="gamgam2",
                                                                      conditionalPanel(
                                                                        condition="input.start3>0",
                                                                        bsPopover("gamgam2","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                        plotOutput("twohistgams"),
                                                                        column(3,
                                                                               #tableOutput("table3"),
                                                                               uiOutput("type1powertext"),
                                                                               htmlOutput("gauge3")),
                                                                        column(4,
                                                                               br(),br(),
                                                                               uiOutput("text3")))))),
                                    column(4))),
                         tabPanel("Comparison over a range",
                                  absolutePanel(
                                    right=110,width=220,draggable=TRUE,cursor="move",
                                           wellPanel(
                                             h5("Gamma distribution 1:"),
                                             sliderInput("ngam21","Sample size:",min=10,max=100,step=10,value=20),
                                             sliderInput("shape21","Shape:",min=.5,max=20,step=.5,value=12),
                                             sliderInput("scale21","Scale:",min=.5,max=10,step=.5,value=.5),
                                             tags$hr(),
                                             h5("Gamma distribution 2:"),
                                             sliderInput("ngam31","Sample size:",min=10,max=100,step=10,value=20),
                                             sliderInput("far2","Range of distance from first Gamma:",min=0,max=20,step=1,value=c(0,6)),
                                             tags$hr(),
                                             sliderInput("alpha31",HTML("Significance level α:"),min=.01,max=1,step=.01,value=.05),
                                             sliderInput("nsim31","Number of simulations:",min=10,max=200,value=50,step=10),br(),
                                             actionButton("start31","Start simulation!"),
                                             br(),br(),br(),
                                             div("Shiny app by",
                                                 a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                             div("Base R code by",
                                                 a(href="http://www.linkedin.com/in/jimmywong46/",target="_blank","Jimmy Wong"),align="right", style = "font-size: 8pt"),
                                             div("Shiny source files:",
                                                 a(href="https://gist.github.com/calpolystat/8f525780393a05e7d0fd",
                                                   target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
                                             div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
                                                   "Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt"))),
                                    column(8,
                                           bsCollapse(multiple=TRUE, open=c("c31","c32"), id="gammavarycollapse",
                                                      bsCollapsePanel("Simulation Information", id="c31",
                                                                      bsPopover("c31","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                      span("In this scenario, the mean of the 1st Gamma distribution remains constant, while the mean of the 2nd
                                                                           Gamma distribution varies depending on the specified range of distance.  The Type 1 error rate and power
                                                                           is compared between the t-test and the WMW test.",
                                                                           style = "color:black")),
                                                      bsCollapsePanel("Simulation Results", id="c32",
                                                                      p("In the generated graph, each point is either a Type I error rate or power;
                                                                        there is at most 1 Type I error rate (when the two population means are the same)."),
                                                                      conditionalPanel(
                                                                        condition="input.start31>0",
                                                                        bsPopover("c32","Collapsible!","Click to collapse.",trigger="hover",placement="top"),
                                                                        htmlOutput("graph.gamgam"))))),
                                    column(3))))

))


letter.frequency <- function(filename)
{
    file <- paste(readLines(filename), collapse = '')
    chars <- strsplit(file, NULL)[[1]]
    summary(factor(chars))
}


derivPulseFits <- function(fitsFile, fitsExt=1, fitsCol="ADC", npulses,
                           pulseLength, startSample,headas){
    #
    # Funtion to calculate derivative of pulses in a FITS file
    # Input:
    #      fitsFile: FITS file with pulses in a column
    #      fitsExt:  FITS file extension
    #      fitsCol:  FITS column name
    #      npulses:  numbre of pulses to be used
    #      pulseLength: pulses length for extraction (<= length of pulses in FITS file)
    #      startSample: initial sample from which pulses will be saved
    #      headas: value of HEADAS variable
    # Output:
    #      derivList: list with differentiated pulses derivList["pulse1"]=c(deriv(1), deriv(2)...)
    #
    src <- paste("source ",headas,"/headas-init.sh",sep="")
    txtFile <- "fitsNoVar.txt"
    comm <- paste("export HEADAS=",headas," && ", src," && fdump infile=",fitsFile, "+",fitsExt," outfile=", txtFile,
                  " columns=",fitsCol," rows=1-",npulses," prhead=no showcol=no showrow=no showunit=no clobber=yes",sep="")
    system(comm)

    DataPulse <-read.table(txtFile, header=F)
    nsamplesPerPulse <- nrow(DataPulse)/npulses
    istart <- startSample # first sample to extract the pulse (usually 1000)

    derivList <- list()
    for (ip in 1:npulses){
        pulseStart <- 1+(ip-1)*nsamplesPerPulse
        pulseEnd <- pulseStart + nsamplesPerPulse-1
        pulseFull <- DataPulse[pulseStart:pulseEnd,1]
        pulse <- pulseFull[istart:(istart+pulseLength-1)]
        pulseID <- paste("pulse",ip,sep="")
        derivList[[pulseID]] <- diff(pulse)
    }
    file.remove(txtFile)
    return(derivList)
}


#!/usr/bin/env Rscript

library(ggplot2)
library(reshape)

hours_m = as.numeric(read.csv("analysis/time-hours-stats.csv",header=F,nrows=1))
hours_stdev = as.numeric(read.csv("analysis/time-hours-stats.csv",
                                  header=F,nrows=1,skip=1))

df <- data.frame(freqs=hours_m,stdev=hours_stdev)
limits <- aes(ymax = freqs + stdev, ymin=freqs - stdev)
p <- ggplot(df,aes(x=0:23,y=freqs)) +
  xlab("Hour of Day") +
  ylab("Average Commands Executed") +
  geom_bar(stat='identity') +
  #geom_errorbar(limits, width=0.25) +
  theme_bw()
ggsave("plots/time-hours-bar.png",width=7,height=6)

hours = read.csv("analysis/time-hours-full.csv",header=F)
df = melt(hours)
p <- ggplot(df, aes(x=value)) +
  stat_ecdf(aes(group = variable)) +
  theme(legend.title=element_blank()) +
  xlab("Number of Hourly Commands") +
  ylab("") +
  theme_bw()
ggsave("plots/time-hours-ecdf.png",width=7,height=6)

wdays_m = as.numeric(read.csv("analysis/time-wdays-stats.csv",header=F,nrows=1))
wdays_stdev = as.numeric(read.csv("analysis/time-wdays-stats.csv",
                                  header=F,nrows=1,skip=1))
wday_str = c("Mon","Tues","Weds","Thurs","Fri","Sat","Sun")
df <- data.frame(freqs = wdays_m, wdays = factor(wday_str,levels=wday_str),
                 stdev=wdays_stdev)
limits <- aes(ymax = freqs + stdev, ymin=freqs - stdev)
p <- ggplot(df,aes(x=wdays,y=freqs)) +
  xlab("Week Day") +
  ylab("Average Commands Executed") +
  geom_bar(stat='identity',aes(y=freqs)) +
  geom_errorbar(limits, width=0.25) +
  theme_bw()
ggsave("plots/time-wdays-bar.png",width=7,height=6)

wdays = read.csv("analysis/time-wdays-full.csv",header=F)
df <- melt(wdays)
p <- ggplot(df, aes(x=value)) +
  stat_ecdf(aes(group=variable,colour=variable)) +
  scale_color_manual(
      name="",
      values = c("#CCE5FF", "#99CCFF", "#66B2FF", "#3399FF",
                 "#0080FF", "#0066CC", "#004C99"),
      labels = c("Mon", "Tues", "Weds", "Thurs", "Fri", "Sat", "Sun")
  ) +
  theme(legend.title=element_blank()) +
  xlab("Number of Daily Commands") +
  ylab("") +
  theme_bw()
ggsave("plots/time-wdays-ecdf.png",width=7,height=6)

top_cmds = read.csv("analysis/top-cmds.csv",header=T)
df <- data.frame(
  freqs = top_cmds[[1]],
  cmd_names = factor(top_cmds[[2]],levels=top_cmds[[2]])
)
p <- ggplot(df,aes(x=cmd_names,y=freqs)) +
  xlab("Command") +
  ylab("Frequency") +
  geom_bar(stat='identity',aes(y=freqs)) +
  theme_bw()
ggsave("plots/top-cmds.png",width=7,height=6)

cmd_lengths = as.numeric(read.csv("analysis/cmd-lengths.csv",header=F))
df = data.frame(cmd_lengths)
p <- ggplot() +
  stat_ecdf(data=df,aes(x=cmd_lengths)) +
  xlab("Base Command Length") +
  ylab("") +
  scale_x_continuous(
      limits=c(0,max(df)),
      breaks=seq(0,max(df),10),
      minor_breaks=seq(0,max(df),5)
  ) +
  theme_bw()
ggsave("plots/cmd-lengths-full.png",width=7,height=6)

p <- ggplot() +
  stat_ecdf(data=df,aes(x=cmd_lengths)) +
  xlab("Base Command Length") +
  ylab("") +
  scale_x_continuous(
      limits=c(0,max(df)/3),
      breaks=seq(0,max(df)/3,10),
      minor_breaks=seq(0,max(df)/3,5)
  ) +
  theme_bw()
ggsave("plots/cmd-lengths-zoomed.png",width=7,height=6)


H02DAJ Example Program Results

 Final Esimate:
          1
 1   0.3750
 2   0.0000
 3   0.5250
 4   0.1000
 5   1.0000
 6   0.0000
 7   1.0000
 8   1.0000
Requested accuracy of QP subproblems    1.0000e-10
Optimised value:        2.925


##Shape=vector point
##Rinde=field Shape
##Distancia=number 20
##output_plots_to_html
##showplots
##inliers=output vector

#02/07/2020
#SE RETOMO LA FUNCION moran.plot ORIGINAL DESDE GITHUB, el 6/05/2020 el autor hizo
#cambios y dejo de funcionar las funciones como estaban programadas
moran.plot2 <- function(x, listw, zero.policy=NULL, spChk=NULL,
                       labels=NULL, xlab=NULL, ylab=NULL, quiet=NULL, ...)
{
  if (!inherits(listw, "listw")) stop(paste(deparse(substitute(listw)),
                                            "is not a listw object"))
  if (is.null(quiet)) quiet <- !get("verbose", envir = .spdepOptions)
  stopifnot(is.vector(x))
  stopifnot(is.logical(quiet))
  if (is.null(zero.policy))
    zero.policy <- get("zeroPolicy", envir = .spdepOptions)
  stopifnot(is.logical(zero.policy))
  xname <- deparse(substitute(x))
  if (!is.numeric(x)) stop(paste(xname, "is not a numeric vector"))
  if (any(is.na(x))) stop("NA in X")
  n <- length(listw$neighbours)
  if (n != length(x)) stop("objects of different length")
  if (is.null(spChk)) spChk <- get.spChkOption()
  if (spChk && !chkIDs(x, listw))
    stop("Check of data and weights ID integrity failed")
  labs <- TRUE
  if (is.logical(labels) && !labels) labs <- FALSE
  if (is.null(labels) || length(labels) != n)
    labels <- as.character(attr(listw, "region.id"))
  wx <- lag.listw(listw, x, zero.policy=zero.policy)
  if (is.null(xlab)) xlab <- xname
  if (is.null(ylab)) ylab <- paste("spatially lagged", xname)
  plot(x, wx, xlab=xlab, ylab=ylab, ...)
  if (zero.policy) {
    n0 <- wx == 0.0
    # bug found 100401 Paulo Grahl
    if (any(n0)) {
      symbols(x[n0], wx[n0], inches=FALSE,
              circles=rep(diff(range(x))/50, length(which(n0))),
              bg="grey", add=TRUE)
    }
  }
  xwx.lm <- lm(wx ~ x)
  abline(xwx.lm)
  abline(h=mean(wx), lty=2)
  abline(v=mean(x), lty=2)
  infl.xwx <- influence.measures(xwx.lm)
  is.inf <- which(apply(infl.xwx$is.inf, 1, any))
  points(x[is.inf], wx[is.inf], pch=9, cex=1.2)
  if (labs)
    text(x[is.inf], wx[is.inf], labels=labels[is.inf], pos=2, cex=0.7)
  rownames(infl.xwx$infmat) <- labels
  if (!quiet) summary(infl.xwx)
  invisible(infl.xwx)
}

library(sp)
library(spdep)

crs_imagen<-st_crs(Shape)
filtro1<-as_Spatial(Shape)
>print(str(filtro1))

>print("Sacando coordenadas")

cord <- filtro1@coords

>print("Generando grilla, suele tardar....")
>print(str(cord ))

gri <- dnearneigh(cord,0,Distancia)

>print(str(gri))

lw <- nb2listw(gri, style = "W")
par(mfrow=c(1,1))

>print("Graficando MORAN....")

ML <- localmoran (filtro1@data[,Rinde], lw, p.adjust.method="bonferroni",alternative ="less",zero.policy=TRUE)
MP <- moran.plot2(filtro1@data[,Rinde],lw,quiet=T,labels=F,col=3,zero.policy=F,xlab="Rendimiento", ylab="Rendimiento Spatially Lagged")
MP
Influ <- MP$is.inf
datos0 <- data.frame(filtro1@data,filtro1@coords,ML,Influ)

#eliminacion de datos con ?ndice de Moran Local negativo y estad?sticamente significativos (p<0.05).
datos1 <- subset(datos0,datos0$Ii > 0 | datos0$Pr.z...0.>0.05)
myshp.inlier<- subset(datos0,datos0$Ii < 0 | datos0$Pr.z...0.<0.05)

datos2 <- datos1[datos1$dfb.1_ == FALSE & datos1$dfb.x == FALSE
                   & datos1$dffit == FALSE & datos1$cov.r == FALSE & datos1$cook.d
                   == FALSE & datos1$hat == FALSE, ]

>print("--------------------------------------------------------")
>str(datos2)

datos3<-data.frame(datos2[Rinde],datos2["coords.x1"],datos2["coords.x2"])
coordinates(datos2)<-c("coords.x1","coords.x2")
output <-sf::st_as_sf(datos3, coords = c("coords.x1", "coords.x2"),crs= crs_imagen)

n<-nrow(filtro1@data[Rinde])-nrow(datos3[Rinde])
>print(paste("Se filtraron",n,"puntos"))

inliers = output


library(optCluster)

d = read.table ({{i.infile | quote}}, sep="\t", header={{args.cnames | R}}, row.names={{args.rnames | lambda x: 'NULL' if not x else int(x)}}, check.names=F)
if ({{args.transpose | R}}) {
	d = t(d)
}
names = rownames(d)
{% if args.methods == 'all' %}
#methods = c("agnes", "clara", "diana", "hierarchical", "kmeans", "pam", "som", "em.nbinom", "da.nbinom", "sa.nbinom", "em.poisson", "da.poisson", "sa.poisson")
methods = c("agnes", "clara", "diana", "hierarchical", "pam", "em.nbinom", "da.nbinom", "sa.nbinom", "em.poisson", "da.poisson", "sa.poisson")
{% elif isinstance(args.methods, list) %}
methods = {{args.methods | Rvec}}
{% else %}
methods = unlist(strsplit({{args.methods | .replace(' ', '') | quote}}, ',', fixed = T))
{% endif %}

if ({{args.isCount | R}}) {
	methods = intersect(c("em.nbinom", "da.nbinom", "sa.nbinom", "em.poisson", "da.poisson", "sa.poisson"), methods)
} else {
	methods = intersect(c("agnes", "clara", "diana", "hierarchical", "kmeans", "model", "pam", "som", "sota", "fanny"), methods)
}
minc = max({{args.minc}}, 2)
maxc = min({{args.maxc}}, nrow(d) - 1)

ret = optCluster(d, minc:maxc, clMethods = methods, countData = {{args.isCount | R}}, clVerbose = T, rankVerbose = F)

ret = optAssign(ret)

outfile = "{{o.outdir}}/clusters.txt"
metfile = "{{o.outdir}}/method.txt"
outfig  = "{{o.outdir}}/clusters.png"
outdir  = "{{o.outdir}}"
clusters = matrix(ret$cluster, ncol=1)
rownames(clusters) = names
write.table (clusters, outfile, row.names=T, sep="\t", quote=F, col.names=F)
write.table (ret$method, metfile, row.names=F, sep="\t", quote=F, col.names=F)
if ({{args.plot | R}}) {
	library(factoextra)
	pdata = list()
	pdata$data = d
	pdata$cluster = ret$cluster
	do.call(png, c(list(file = outfig), {{args.devpars | Rlist}}))
	print (fviz_cluster(pdata, data=d, main = ""))
	dev.off()
}


#Replication data for:
#Berliner, Daniel. 2014. The Political Origins of Transparency. The Journal of Politics, 76(2): 479-491.

setwd("~/Dropbox/Duke/Spring 2015/PS 733/Other/Berliner")

data<-read.csv("FOI_passage_finaldata.csv", header=T)

#variable definitions
#CODE country code
#YEAR year
#DEVELOPING indicator for developing countries
#FOIPASS year of FOI law passage
#turnfreq frequency of turnover
#opp1vote vote share of largest opposition party
#oppvote vote share of all opposition parties
#opp1vote_dev change over time in opp1vote
#turnfreq1 turnover frequency in categories
#FOI_REGIONAL neighborhood context of FOI passage
#FOI_IGO inter-governmental organization context of FOI passage
#polity2 Polity2 democracy index
#NEWDEM new democracy indicator
#logINGO log INGO memberships
#CORRUPTION Transparency International CPI, average over time
#logtrade log trade per GDP
#loggdpcap log GDP per capita
#AID_DEPENDENCE log foreign aid per GDP
#IMFDUMMY use of IMF credit
#FHDEM Freedom House democracy measure
#checks veto players measure from DPI
#PRESSFREEDOM Freedom House freedom of the press
#PRES presidential systems from DPI
#FDISTOCK stock of inward FDI, from UNCTAD
#GDPGRTH GDP growth
#BATTLEDEATHS battle deaths
#INJUD judicial independence from CIRI
#yrcurnt years in office of current ruling party, from DPI

options(scipen=10)

#this function from Chris Adolph simcf package, available on his website
extractdata<-function (formula, data, extra = NULL, na.rm = FALSE)
{
    subdata <- get_all_vars(formula, data)
    if (!is.null(extra)) {
        if (is.data.frame(extra)) {
            subdata <- cbind(subdata, extra)
        }
        else {
            if (any(class(extra) == "formula")) {
                subdata <- cbind(subdata, get_all_vars(extra,
                  data))
            }
            else {
                stop("Extra must be a dataframe or formula object")
            }
        }
    }
    if (na.rm)
        subdata <- na.omit(subdata)
    subdata
}

#data is all years all countries
#data_d is all years developing countries only
#data_s is post90 all countries
#data_ds is post90 developing only
data_d<-data[data$DEVELOPING==1,]
data_s<-data[data$YEAR>1989,]
data_ds<-data_d[data_d$YEAR>1989,]

#set which sample to use
data_x<-data_ds

###Models in main text of paper:

# .... removing code for models 1 through 4

#model 4: both
formula1<-FOIPASS ~
polity2 +
turnfreq +
opp1vote +
NEWDEM +
logINGO +
CORRUPTION +
logtrade +
loggdpcap +
AID_DEPENDENCE +
IMFDUMMY  +
FOI_REGIONAL+
FOI_IGO

mdata1<-extractdata(formula1, data_x, extra=data_x[,c("CODE","YEAR")], na.rm = TRUE)
uc1<-unique(as.character(mdata1$CODE))
mdata1$yearsatrisk<-rep(NA,nrow(mdata1))
for(i in 1:length(uc1)){mdata1$yearsatrisk[mdata1$CODE==uc1[i]]<- 1:(length(mdata1$yearsatrisk[mdata1$CODE==uc1[i]])) }

formula1<-paste("FOIPASS","~",
"polity2 +opp1vote + turnfreq +FOI_REGIONAL+ FOI_IGO+ NEWDEM  +logINGO+CORRUPTION +loggdpcap +logtrade + AID_DEPENDENCE +IMFDUMMY", sep="")

yearsatrisk_dummies <- model.matrix(~factor(mdata1$yearsatrisk)-1)
yearsatrisk_dummies<-yearsatrisk_dummies[,-1]
selectdata <- cbind(mdata1,yearsatrisk_dummies)
ddnames <- NULL
for (i in 1:ncol(yearsatrisk_dummies)) {
  formula1 <- paste(formula1,"+dd",i,sep="")
  ddnames <- c(ddnames,paste("dd",i,sep=""))
}
names(selectdata) <- c(names(mdata1),ddnames)

m4<-glm(as.formula(formula1), data=selectdata, family=binomial(link="logit"), control=glm.control(maxit=500))
summary(m4)

###############################################################
### My attempt to replicate figure 2

# Create scenario matrix for figure 2
data = read.csv('fulldata.csv')
data08 = data[data$YEAR==2008,] # Subset to 2008, so we can get mean 2008 levels
vars = names(coef(m4)); vars=vars[-1] # Pull out coefficients used in model 4, take out intercept
ivs = intersect(vars, names(data08))
simData = apply(data08[,ivs], 2, function(x){ mean(x, na.rm=TRUE) }) # Calculate mean of every variable in 2008

# IMF dummy and NEW dem should be set at median (Berliner doesnt do this but you should)
simData['IMFDUMMY'] = median(data08$IMFDUMMY, na.rm=T)
simData['NEWDEM'] = median(data08$NEWDEM, na.rm=T)

# Add duration dummies
ddums = rep(0, 18); names(ddums)=paste0('dd',1:18)
simData = c(simData, ddums)
simData['dd18'] = 1 # Set duration dependent dummy 18 to one

turnFreqRange = seq(0,4,.25) # Set up varying values for turnover frequency
scen = NULL ; for(ii in 1:length(turnFreqRange)){ scen=rbind(scen,simData) } # Expand scenario vector into matrix
scen[,'turnfreq'] = turnFreqRange # Replace mean turn over frequency value with varying values from 0 to 4
scen = cbind(1, scen) # Add intercept term
print(scen)

# Run sims
library(MASS) # load mass library for mvrnorm function
set.seed(6886) # set seed
sims=10000 # number of simulations
draws = mvrnorm(sims, coef(m4), vcov(m4)) # sample from multivariate normal
yVals = draws %*% t(scen) # Calculate predicted values
yProbs = 1/(1+exp(-yVals)) # Calculate predicted probabilities by applying logistic link function

# Get summary stats by scenario
info = function(x){ c( mean(x), quantile(x, probs=c(0.025, 0.975)) )  } # Function to calculate mean and 95% interval for every scenario
ySumm = t(apply(yProbs, 2, info)) # Apply function above to columns of yProbs matrix
colnames(ySumm)=c('mu','lo','hi') # Label columns

# Plot for gg
ggData = data.frame(turnFreqRange, ySumm, row.names=NULL) # Convert to dataframe for plotting

library(ggplot2) # load ggplot library
# Plot
tmp=ggplot(ggData, aes(x=turnFreqRange, y=mu, ymin=lo, ymax=hi))
tmp=tmp + geom_line() + geom_ribbon(alpha=.5)
tmp=tmp + scale_y_continuous(breaks=seq(0,1,.2), labels=seq(0,1,.2))
tmp=tmp + ylab('Probability of FOI Passage') + xlab('Turnover Frequency')
tmp
###############################################################


# A user-friendly function to get QC values for PROBA-V

# True means must have, False means must not have, NA means don't care
GetProbaVQCMask = function(bluegood = NA, redgood = NA, nirgood = NA, swirgood = NA, land = NA, ice = NA, cloud = NA, shadow = NA)
{
  bluegoodbit = bitwShiftL(1, 7)
  redgoodbit = bitwShiftL(1, 6)
  nirgoodbit = bitwShiftL(1, 5)
  swirgoodbit = bitwShiftL(1, 4)
  landbit = bitwShiftL(1, 3)
  icebit = bitwShiftL(1, 2)
  cloudbit = bitwShiftL(1, 1)
  shadowbit = bitwShiftL(1, 0)

  # If True, add the bit, if False don't, if NA keep original and also add it
  BitIterator = function(input, state, bit)
  {
    if(is.na(state))
      input = c(input, input + bit)
    else if(state)
      input = input + bit
    return(input)
  }

  result = 0L
  result = BitIterator(result, bluegood, bluegoodbit)
  result = BitIterator(result, redgood, redgoodbit)
  result = BitIterator(result, nirgood, nirgoodbit)
  result = BitIterator(result, swirgood, swirgoodbit)
  result = BitIterator(result, land, landbit)
  result = BitIterator(result, ice, icebit)
  result = BitIterator(result, cloud, cloudbit)
  result = BitIterator(result, shadow, shadowbit)

  return(result)
}


# -----------------------------------------------------------------------------
# PROJECT:
#    Evaluating the structure of the communities of the estuary
#    and gulf of St.Lawrence
# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------
# STEP:
#   2. Analysis iteratively removing information from the catalog
# -----------------------------------------------------------------------------

# Evaluating algorithm accuracy ~ # of taxa in the catalog
# -----------------------------------------------------------------------------
# FILES:
#   RData <- file = "RData/Tanimoto_analysis.RData" XXX adjust name with type of analysis
#   Script  <- file = "Script/2-1-Tanomoto_analysis.r"
# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------
# PARAMETERS:

# -----------------------------------------------------------------------------

# -----------------------------------------------------------------------------
# SCRIPT
# -----------------------------------------------------------------------------
load("./RData/interactions_source.RData")
filename <- 'multiple_parameters2'

multiple_parameters2 <- tanimoto_analysis(filename = filename,
                                            min.tx = 45,
                                            K.values = c(2,4,6,8),
                                            MW = 1,
                                            WT = c(0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1),
                                            blind = FALSE,
                                            minimum_threshold = 0.3)

WT = c(0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1)
K.values = c(2,4,6,8)
MW = 1

# Catalog vs predictions
load('./Analyses/multiple_parameters2.RData')
multiple_parameters2 <- Tanimoto_analysis
accuracy  <- vector('list', 3)
names(accuracy) <- c('Catalog', 'Predict', 'Algorithm')
accuracy[[1]] <- tanimoto_accuracy(Tanimoto_analysis = multiple_parameters2, empirical.only = TRUE)
accuracy[[2]] <- tanimoto_accuracy(Tanimoto_analysis = multiple_parameters2, predict.only = TRUE)
accuracy[[3]] <- tanimoto_accuracy(Tanimoto_analysis = multiple_parameters2)

#Figure
pdf(paste('./Article/',filename,'.pdf',sep=''),width=12,height=7)
# Plots
par(mfrow=c(2,2))
# layout(matrix(c(1,2,5,5,3,4), 3, 2, byrow = TRUE), heights = c(4.5,1,4.5))

nb.pts <- length(unique(accuracy[[1]][,'MW'])) * length(unique(accuracy[[1]][,'K'])) * length(unique(accuracy[[1]][,'wt']))

# Graph
for(j in 9:12) {
        eplot(xmin = -0.09, xmax = nb.pts, ymax = 3.5)
        par(pch = 21,  xaxs = "i", yaxs = "i", family = "serif")
        foodwebs <- names(multiple_parameters2[[1]][[1]][[1]])
        names <- c('TSS','Score y', 'Score -y', 'Accuracy score')
        col <- c("#FF8822","#449955","#2288FF")
        # col <- c("#FF000000","#00FF0088","#0000FF88")
        # col <- gray.colors(11, start = 0, end = 0.8, gamma = 2.2, alpha = NULL) # grey scale ramp
        # col <- sample(colours(), length(foodwebs))

        # Axes
            axis(side = 1, at = seq(0, nb.pts, by = length(WT) * length(K.values)) + 0.5, labels = FALSE, las = 1, pos = -0.02) #MW
            axis(side = 2, at = seq(0, 1, by = 0.25), labels = seq(0, 1, by = 0.25), las = 1, pos = -0.02)
            axis(side = 2, at = seq(0, 1, by = 0.25)+1.25, labels = seq(0, 1, by = 0.25), las = 1, pos = -0.02)
            axis(side = 2, at = seq(0, 1, by = 0.25)+2.5, labels = seq(0, 1, by = 0.25), las = 1, pos = -0.02)
            axis(side = 3, at = seq(0, nb.pts, by = length(K.values)) + 0.5, labels = FALSE, las = 1, pos = 1.02 + 2.5) #wt
            axis(side = 4, at = seq(0, 1, by = 0.25), labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.02) + 1)
            axis(side = 4, at = seq(0, 1, by = 0.25)+1.25, labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.02) + 1)
            axis(side = 4, at = seq(0, 1, by = 0.25)+2.5, labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.02) + 1)

            abline(v = seq(length(K.values)+0.5,(nb.pts-length(K.values))+0.5,by = length(K.values)), col = "grey", lty = 2)
            # abline(v = seq((length(WT) * length(K.values))+0.5, (nb.pts - (length(WT) * length(K.values)))+0.5, by = length(WT) * length(K.values)), col = "blue", lty = 2)
            abline(h = c(1.125,2.375), col = "black", lty = 2)

            mtext(text = names[j-8], side = 2, line = 2, at = 1.75, font = 2, cex = 1)
            mtext(text = "Similarity weight", side = 3, line = 2, at = 25, font = 2, cex = 1)
            mtext(text = "Minimum weight", side = 1, line = 2, at = 25, font = 2, cex = 1)
            mtext(text = MW, side = 1, line = 1, at = seq(nb.pts/length(MW), nb.pts, by = nb.pts/length(MW)) - ((nb.pts/length(MW)) / 2) + 0.5, font = 1, cex = 0.75)
            mtext(text = rep(WT, times = length(WT)), side = 3, line = 1, at = seq((nb.pts/length(MW))/length(WT), nb.pts, by = ((nb.pts/length(MW)) / length(WT))) - ((nb.pts/length(MW)) / length(WT) / 2) + 0.5, font = 1, cex = 0.75)
            text(x = 1, y = 0.15, labels = 'Catalog', font = 2, cex = 1, col = col[1], adj = 0)
            text(x = 1, y = 1.40, labels = 'Predictions', font = 2, cex = 1, col = col[2], adj = 0)
            text(x = 1, y = 2.65, labels = 'Algorithm', font = 2, cex = 1, col = col[3], adj = 0)

        it <- 0
        for(i in 1:length(accuracy)) {
            accuracy_mean <- aggregate(as.numeric(accuracy[[i]][,j]) ~ as.numeric(accuracy[[i]][, 'K']) + as.numeric(accuracy[[i]][, 'wt']), data=accuracy[[i]], FUN=function(x) c(mean=mean(x), sd=sd(x)))
            accuracy_mean <- accuracy_mean[order(accuracy_mean[,2]), ]
            # hack: we draw arrows but with very special "arrowheads" for error bars
            arrows(seq(1,nb.pts), accuracy_mean[, 3][,1] - accuracy_mean[, 3][, 2]+it, seq(1,nb.pts), accuracy_mean[, 3][, 1] + accuracy_mean[, 3][, 2]+it, length=0.025, angle=90, code=3, col = col[i])
            points(x = seq(1,nb.pts), y = accuracy_mean[, 3][, 1]+it, cex = 0.75, pch = 22, col = col[i])
            it <- it + 1.25
        } #i

        # ## Add legend
        # if(j == 9) {
        #     legend(0.5, 0.5, lwd = 3, col = col, legend = names(accuracy), bty = 'n', y.intersp = 1)
        # }
} #j

dev.off()

#Figure2 - article couleur
# pdf(paste('./Article/',filename,'.pdf',sep=''),width=6,height=8)
jpeg(paste('./Article/Revisions/','Figure2','.jpeg',sep=''),width=6,height=8, res = 300, units = 'in') #jpeg for submission
# Plots
par(mfrow=c(3,1), mar=c(4,4,4,4))
par(pch = 21,  xaxs = "i", yaxs = "i", family = "serif")
# layout(matrix(c(1,2,3), 3, 1, byrow = TRUE), heights = c(4,4,4))

nb.pts <- length(unique(accuracy[[1]][,'MW'])) * length(unique(accuracy[[1]][,'K'])) * length(unique(accuracy[[1]][,'wt']))

# Graph
for(j in c(10,11,9)) {
    # j = 9

        eplot(xmin = -1, xmax = nb.pts+1, ymax = 3.6)
        foodwebs <- names(multiple_parameters2[[1]][[1]][[1]])
        col <- c("#FF8822","#449955","#2288FF")

        # Axes
            axis(side = 1, at = seq(0, nb.pts, by = length(K.values)), labels = FALSE, las = 1, pos = -0.2) #wt
            axis(side = 2, at = seq(0, 1, by = 0.25), labels = seq(0, 1, by = 0.25), las = 1, pos = -0.2)
            axis(side = 2, at = seq(0, 1, by = 0.25)+1.25, labels = seq(0, 1, by = 0.25), las = 1, pos = -0.2)
            axis(side = 2, at = seq(0, 1, by = 0.25)+2.5, labels = seq(0, 1, by = 0.25), las = 1, pos = -0.2)
            axis(side = 3, at = seq(0, nb.pts, by = 1), labels = FALSE, las = 1, pos = 1.2 + 2.5) #K.values
            axis(side = 4, at = seq(0, 1, by = 0.25), labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.2))
            axis(side = 4, at = seq(0, 1, by = 0.25)+1.25, labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.2))
            axis(side = 4, at = seq(0, 1, by = 0.25)+2.5, labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.2))

            abline(v = seq(length(K.values),(nb.pts-length(K.values)),by = length(K.values)), col = "grey", lty = 2)
            # abline(v = seq((length(WT) * length(K.values))+0.5, (nb.pts - (length(WT) * length(K.values)))+0.5, by = length(WT) * length(K.values)), col = "blue", lty = 2)
            abline(h = c(1.125,2.375), col = "black", lty = 2)

            if(j == 9) {
                mtext(text = 'TSS', side = 2, line = 2, at = 1.75, font = 1.5, cex = 1)
            } else if(j == 10) {
                mtext(text = expression('Score'[y]), side = 2, line = 2, at = 1.75, font = 1.5, cex = 1)
            } else if(j == 11) {
                mtext(text = expression('Score'[-y]), side = 2, line = 2, at = 1.75, font = 1.5, cex = 1)
            }

            mtext(text = "K values", side = 3, line = 2, at = nb.pts/2, font = 1.5, cex = 1)
            mtext(text = "Similarity weight", side = 1, line = 2.5, at = nb.pts/2, font = 1.5, cex = 1)
            mtext(text = rep(K.values, times = length(WT)), side = 3, line = 1, at = seq(0.5, nb.pts-0.5, by = 1), font = 1, cex = 0.75)
            mtext(text = rep(WT, times = length(WT)), side = 1, line = 1.5, at = seq((nb.pts/length(MW))/length(WT), nb.pts, by = ((nb.pts/length(MW)) / length(WT))) - ((nb.pts/length(MW)) / length(WT) / 2) + 0.5, font = 1, cex = 0.75)
            text(x = 1, y = 0.15, labels = 'Catalogue', font = 2, cex = 1, col = col[1], adj = 0)
            text(x = 1, y = 1.40, labels = 'Predictions', font = 2, cex = 1, col = col[2], adj = 0)
            text(x = 1, y = 2.65, labels = 'Algorithm', font = 2, cex = 1, col = col[3], adj = 0)

        it <- 0
        for(i in 1:length(accuracy)) {
            accuracy_mean <- aggregate(as.numeric(accuracy[[i]][,j]) ~ as.numeric(accuracy[[i]][, 'K']) + as.numeric(accuracy[[i]][, 'wt']), data=accuracy[[i]], FUN=function(x) c(mean=mean(x), sd=sd(x)))
            accuracy_mean <- accuracy_mean[order(accuracy_mean[,2]), ]
            # hack: we draw arrows but with very special "arrowheads" for error bars
            arrows(seq(1,nb.pts)-0.5, accuracy_mean[, 3][,1] - accuracy_mean[, 3][, 2]+it, seq(1,nb.pts)-0.5, accuracy_mean[, 3][, 1] + accuracy_mean[, 3][, 2]+it, length=0.025, angle=90, code=3, col = col[i])
            points(x = seq(1,nb.pts)-0.5, y = accuracy_mean[, 3][, 1]+it, cex = 0.75, pch = 22, col = col[i])
            it <- it + 1.25
        } #i
} #j

dev.off()

#Figure3 - article B&W
# pdf(paste('./Article/',filename,'.pdf',sep=''),width=6,height=8)
jpeg(paste('./Article/Revisions/','Figure2_BW','.jpeg',sep=''),width=6,height=8, res = 300, units = 'in') #jpeg for submission
# Plots
par(mfrow=c(3,1), mar=c(4,4,4,4))
par(pch = 21,  xaxs = "i", yaxs = "i", family = "serif")
# layout(matrix(c(1,2,3), 3, 1, byrow = TRUE), heights = c(4,4,4))

nb.pts <- length(unique(accuracy[[1]][,'MW'])) * length(unique(accuracy[[1]][,'K'])) * length(unique(accuracy[[1]][,'wt']))

# Graph
for(j in c(10,11,9)) {
    # j = 9

        eplot(xmin = -1, xmax = nb.pts+1, ymax = 3.6)
        foodwebs <- names(multiple_parameters2[[1]][[1]][[1]])
        col <- c("black","black","black")

        # Axes
            axis(side = 1, at = seq(0, nb.pts, by = length(K.values)), labels = FALSE, las = 1, pos = -0.2) #wt
            axis(side = 2, at = seq(0, 1, by = 0.25), labels = seq(0, 1, by = 0.25), las = 1, pos = -0.2)
            axis(side = 2, at = seq(0, 1, by = 0.25)+1.25, labels = seq(0, 1, by = 0.25), las = 1, pos = -0.2)
            axis(side = 2, at = seq(0, 1, by = 0.25)+2.5, labels = seq(0, 1, by = 0.25), las = 1, pos = -0.2)
            axis(side = 3, at = seq(0, nb.pts, by = 1), labels = FALSE, las = 1, pos = 1.2 + 2.5) #K.values
            axis(side = 4, at = seq(0, 1, by = 0.25), labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.2))
            axis(side = 4, at = seq(0, 1, by = 0.25)+1.25, labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.2))
            axis(side = 4, at = seq(0, 1, by = 0.25)+2.5, labels = seq(0, 1, by = 0.25), las = 1, pos = (nb.pts + 0.2))

            abline(v = seq(length(K.values),(nb.pts-length(K.values)),by = length(K.values)), col = "grey", lty = 2)
            # abline(v = seq((length(WT) * length(K.values))+0.5, (nb.pts - (length(WT) * length(K.values)))+0.5, by = length(WT) * length(K.values)), col = "blue", lty = 2)
            abline(h = c(1.125,2.375), col = "black", lty = 2)

            if(j == 9) {
                mtext(text = 'TSS', side = 2, line = 2, at = 1.75, font = 1.5, cex = 1)
            } else if(j == 10) {
                mtext(text = expression('Score'[y]), side = 2, line = 2, at = 1.75, font = 1.5, cex = 1)
            } else if(j == 11) {
                mtext(text = expression('Score'[-y]), side = 2, line = 2, at = 1.75, font = 1.5, cex = 1)
            }

            mtext(text = "K values", side = 3, line = 2, at = nb.pts/2, font = 1.5, cex = 1)
            mtext(text = "Similarity weight", side = 1, line = 2.5, at = nb.pts/2, font = 1.5, cex = 1)
            mtext(text = rep(K.values, times = length(WT)), side = 3, line = 1, at = seq(0.5, nb.pts-0.5, by = 1), font = 1, cex = 0.75)
            mtext(text = rep(WT, times = length(WT)), side = 1, line = 1.5, at = seq((nb.pts/length(MW))/length(WT), nb.pts, by = ((nb.pts/length(MW)) / length(WT))) - ((nb.pts/length(MW)) / length(WT) / 2) + 0.5, font = 1, cex = 0.75)
            text(x = 1, y = 0.15, labels = 'Catalogue', font = 2, cex = 1, col = col[1], adj = 0)
            text(x = 1, y = 1.40, labels = 'Predictions', font = 2, cex = 1, col = col[2], adj = 0)
            text(x = 1, y = 2.65, labels = 'Algorithm', font = 2, cex = 1, col = col[3], adj = 0)

        it <- 0
        for(i in 1:length(accuracy)) {
            accuracy_mean <- aggregate(as.numeric(accuracy[[i]][,j]) ~ as.numeric(accuracy[[i]][, 'K']) + as.numeric(accuracy[[i]][, 'wt']), data=accuracy[[i]], FUN=function(x) c(mean=mean(x), sd=sd(x)))
            accuracy_mean <- accuracy_mean[order(accuracy_mean[,2]), ]
            # hack: we draw arrows but with very special "arrowheads" for error bars
            arrows(seq(1,nb.pts)-0.5, accuracy_mean[, 3][,1] - accuracy_mean[, 3][, 2]+it, seq(1,nb.pts)-0.5, accuracy_mean[, 3][, 1] + accuracy_mean[, 3][, 2]+it, length=0.025, angle=90, code=3, col = col[i])
            points(x = seq(1,nb.pts)-0.5, y = accuracy_mean[, 3][, 1]+it, cex = 0.75, pch = 22, col = col[i])
            it <- it + 1.25
        } #i
} #j

dev.off()


p = bio.snowcrab::load.environment()

a = logbook.db('logbook.filtered.positions')

ii = which(a$cfa =='cfa4x')
a = a[ii,]
a$datf = strptime(a$date.fished,format='%Y-%m-%d')
ij = which(is.na(a$datf))
a$datf[ij] = strptime(a$date.fished[ij],format='%Y%m%d')
b= aggregate(date.fished~yr,data = a, FUN=min)
b$datf = strptime(b$date.fished,format='%Y-%m-%d')

out = data.frame(yr=NA,nblocks=NA,nsamples=NA,meancpue=NA,sdcpue=NA)
for(i in 1:nrow(b)) {
                r = a[which(a$yr == b[i,'yr']),]

                out[i,'yr'] = b[i,'yr']
                out[i,'nblocks'] = nrow(unique(cbind(r[which(!is.na(r$landings)),c('lat','lon')])))
                out[i,'nsamples'] = nrow(r[which(!is.na(r)),])
                out[i,'meancpue'] = mean(r$cpue,na.rm=T)
                out[i,'sdcpue'] = sd(r$cpue,na.rm=T)/sqrt(length(r$cpue))
}

#plot the cpue
par(mar=c(5,4,4,5))
ylim=c(min(out$meancpue-out$sdcpue),max(out$meancpue+out$sdcpue))
with(out,plot(yr-1,meancpue,type='b',ylim=ylim,xlab='Year',ylab=expression(Fishery (kg / trap)))) #to put on same year as survey
with(out,arrows(x0=yr-1,y0=meancpue,y1=meancpue+sdcpue,length=0.05,angle=90))
with(out,arrows(x0=yr-1,y0=meancpue,y1=meancpue-sdcpue,length=0.05,angle=90))

# survey data
 k = snowcrab.db(DS = 'set.biologicals', p = p)

 l = aggregate(totmass.male.com~cfa+yr,data = k, FUN = mean)
 m = aggregate(totmass.male.com~cfa+yr,data = k, FUN = sd)
 n = aggregate(totmass.male.com~cfa+yr,data = k, FUN = length)
 names(m)[3]  = 'totmass.male.com.sd'
 names(n)[3]  = 'totmass.male.com.n'

a = merge(merge(l,m),n)
a$se = a$totmass.male.com.sd / sqrt(a$totmass.male.com.n)
b = a[which(a$cfa=='cfa4x'),]

b$upper = b$totmass.male.com +b$se
b$lower = b$totmass.male.com -b$se
b[which(b$yr<2004),c(3:8)]<-NA
par(mar=c(5,4,4,5),new=T)
with(b,plot(yr,totmass.male.com*1000,type='b',xlab='Year',ylim=c(0,max(b$upper,na.rm=T)*1000),yaxt='n',col='red',ylab=""))
with(b,arrows(x0=yr,y0=totmass.male.com*1000,y1=upper*1000,length=0.05,angle=90,col='red'))
with(b,arrows(x0=yr,y0=totmass.male.com*1000,y1=lower*1000,length=0.05,angle=90,col='red'))
axis(side=4,at=seq(round(min(b$lower,na.rm=T)*1000),round(max(b$upper,na.rm=T)*1000),100))
mtext(side=4,line=3,expression('Survey' (kg/km^2)))
legend('topleft',lty=c(1,1),pch=c(1,1),cex=0.8, bty='n',c('Fishery','Survey'),col=c('black','red'))
savePlot('4xfisherysurvey.png',type='png')


REBOL [
    Title: "Functions for converting and exchanging decimal values"
    File:  %decimal.r
    Author: "Eric Long"
    Email: kgd03011@nifty.ne.jp
    Co-Authors: ["Larry Palmiter" "Gerald Goertzel" "Oldes"]
    Date: 7-Jan-2012
    Category: [math util 4]
    Version: 1.0.1
    History: [
        1.0.0 15-Feb-2000 "Original Eric's version"
        1.0.1 7-Jan-2012 "Added real/to-native32 and real/from-native32 functions"
    ]
    Purpose: {
        Contains functions for the manipulation of decimal values,
        packaged into the REAL object. These provide full support for
        native binary floating-point file IO, compatible with C,
        FORTRAN, etc. REBOL decimal and money values may also be saved
        and loaded with no roundoff error. This package is necessary
        because the standard REBOL representation of decimal values
        may round off one or two significant digits, and the rounding
        of money values is an even greater source of error.

        This script contains two more objects, IEEE and EMPIRICAL,
        which provide several functions useful for exploring how
        decimal values are represented as double floating point numbers,
        and for testing the inexactness of the REBOL comparison functions.
    }
    Dependencies: [
        {The following require %format.r to properly format the output,
        though they will work without it. %format.r should be loaded
        before this script.}

        real/form
        real/show/decimal
        IEEE/rebtest
        empirical/rebtest

        {please download: } http://www.rebol.org/utility/format.r
    ]
]

comment { =============== REAL ===============

REAL is an object that packages several functions useful for examining,
saving, exporting and importing decimal values:

Main Interface Functions
FORM           Returns precise decimal representation (requires format.r).
SHOW           Returns a string showing the bits in the IEEE representation.
TO-NATIVE      Converts a decimal value into a native IEEE binary
FROM-NATIVE    Converts an 8-byte native binary into a decimal value.
SAVE           Saves a value with all decimal values converted.
LOAD           Loads a value and restores 8-byte binaries to decimals.
WRITE          Writes a block of decimal values to a file in native form.
READ           Reads a file containing a series of decimal values expressed
               in native form.

Helper Functions
SPLIT          Returns a block with the three components of the IEEE
               double floating point representation of a decimal value.
CONVERT        Converts all decimal values to native binaries, leaves other
               values untouched.
RESTORE        Restores 8-byte binaries to decimal values.
TO-BIN         Returns a binary string representation or a numeric value.
FROM-BIN       Returns the integer represented by string of 1's and 0's.
TO-MATRIX      Converts a flat block into nested blocks of any depth.

}

real: make object! [

comment { =============== REAL/FORM ===============

NOTE: Please see FULL-FORM in format.r for details.

}

; Set the word FORM in the context of this object:
; either to the function FULL-FORM if available, or else to the global FORM.

form: either value? 'full-form [:full-form][get in system/words 'form]

comment { =============== REAL/SHOW ===============

EXAMPLES:

>> real/show 2
== {0 10000000000 0000000000000000000000000000000000000000000000000000}
>> real/show 3
== {0 10000000000 1000000000000000000000000000000000000000000000000000}
>> real/show 3.5
== {0 10000000000 1100000000000000000000000000000000000000000000000000}
>> real/show 4
== {0 10000000001 0000000000000000000000000000000000000000000000000000}
>> real/show/decimal 3.5
== "0 1024 3377699720527872"          ; requires format.r

>> real/show ieee/max-real
== {0 11111111110 1111111111111111111111111111111111111111111111111111}

}

show: func [
    "return an IEEE-compatible string representation in binary"
    x  [number!]
    /decimal  "return a decimal representation"
    /local out sign exponent fraction
][
    set [sign exponent fraction] split x
    out: copy "  "
    either decimal [
        append out form fraction
        insert next out form exponent
        insert out sign
    ][
        append out to-bin/length fraction 52
        insert next out to-bin/length exponent 11
        insert out sign
    ]
    out
]

comment { =============== REAL/TO-NATIVE REAL/FROM-NATIVE ===============

EXAMPLES:

>> real/to-native pi
== #{400921FB54442D18}
>> real/to-native/rev pi
== #{182D4454FB210940}            ; configuration used in PC's
>> real/from-native real/to-native pi
== 3.14159265358979
>> pi - real/from-native real/to-native pi
== 0                              ; converts back to exact value
}

to-native: func [
    "convert a numerical value into native binary format"
    x  [number!]
    /rev     "reverse binary output"
    /local out sign exponent fraction
][
    set [sign exponent fraction] split x
    out: copy #{}
    loop 6 [
        insert out to char! byte: fraction // 256
        fraction: fraction - byte / 256
    ]
    insert out to char! exponent // 16 * 16  + fraction
    insert out to char! exponent / 16 + (128 * sign)
    return either rev [head reverse out][out]
]
to-native32: func [
    "convert a numerical value into native binary format"
    x  [number!]
    /rev     "reverse binary output"
    /local out sign exponent fraction
][
    set [sign exponent fraction] split32 x
    out: copy #{}
    loop 2 [
        insert out to char! byte: fraction // 256
        fraction: fraction - byte / 256
    ]
    insert out to char! exponent * 128 // 256  + fraction
    insert out to char! exponent / 2 + (128 * sign)
    return either rev [head reverse out][out]
]
from-native: func [
    {convert a binary native into a decimal value - also accepts a binary
    string representation in the format returned by REAL/SHOW}
    in      [binary! string!]
    /rev    "binary input in reverse order"
    /local sign exponent fraction
][
    in: copy in
    either binary? in [
        if rev [reverse in]
        sign: either zero? to integer! (first in) / 128 [1][-1]
        exponent: (first in) // 128 * 16 + to integer! (second in) / 16
        fraction: to decimal! (second in) // 16
        in: skip in 2
        loop 6 [
            fraction: fraction * 256 + first in
            in: next in
        ]
    ][
        set [sign exponent fraction] parse in none
        sign: either sign = "0" [1][-1]
        exponent: from-bin exponent
        fraction: from-bin fraction
    ]
    sign * either zero? exponent [
        2 ** -1074 * fraction
    ][
        2 ** (exponent - 1023) * (2 ** -52 * fraction + 1)
    ]
]
from-native32: func [
    {convert a binary native into a decimal value - also accepts a binary
    string representation in the format returned by REAL/SHOW}
    in      [binary! string!]
    /rev    "binary input in reverse order"
    /local sign exponent fraction
][
    in: copy in
    either binary? in [
        if rev [reverse in]
        sign: either zero? to integer! (first in) / 128 [1][-1]
        exponent: ((first in) and 127) * 2 + to integer! (second in) / 128
        fraction: to decimal! (second in) // 128
        in: skip in 2
        loop 2 [
            fraction: fraction * 256 + first in
            in: next in
        ]
    ][
        set [sign exponent fraction] parse in none
        sign: either sign = "0" [1][-1]
        exponent: from-bin exponent
        fraction: from-bin fraction
    ]
    sign * either zero? exponent [
        2 ** -149 * fraction
    ][
        2 ** (exponent - 127) * (2 ** -23 * fraction + 1)
    ]
]
comment { =============== REAL/SAVE REAL/LOAD ===============

REAL/SAVE and REAL/LOAD are meant to be completely compatible
with the standard functions SAVE and LOAD, except that there
will be no roundoff error from saving and loading decimal
or money values.

EXAMPLE:

>> amount: [100 * $1.504]
== [100 * $1.50]

>> save %test-x.dat amount
>> do load %test-x.dat
== $150.00                             ; large round-off error

>> real/save %test-y.dat amount
>> do real/load %test-y.dat
== $150.40                             ; no error
}

save: func [
    {Saves a value with all decimals converted to binary natives}
    where [file! url!] "Where to save it."
    value              "Value to save."
    /header            "Save it with a header"
        header-data [block! object!] "Header block or object"
][
    either header [
        system/words/save/header where convert :value convert header-data
    ][
        system/words/save where convert :value
    ]
]

load: func [
    {Loads a value and converts binary natives to decimals}
    source [file! url! string! any-block!]
    /header "Includes REBOL header object if present"
    /next   {Load the next value only.
            Return block with value and new position.}
    /local lp
][
    lp: copy 'system/words/load
    foreach item [header next][
        if get item [insert tail :lp item]
    ]
    restore lp source
]

comment { =============== REAL/WRITE REAL/READ ===============

NOTE: REAL/WRITE and REAL/READ are meant for writing and reading
      decimal values in native binary format. REAL/WRITE accepts
      a single numerical value or a block of numerical values that
      may be nested to any depth, but the return value of REAL/READ
      is always a flat block.

EXAMPLES:

>> b1: [] for x 1 16 1 [append b1 square-root x]
== [1 1.4142135623731 1.73205080756888 2 2.23606797749979 ...
>> real/write %test.bin b1
16 decimal values written

>> bb1: real/read %test.bin
== [1 1.4142135623731 1.73205080756888 2 2.23606797749979 ...
>> b1/7 - probe bb1/7
2.64575131106459                ; square root of 7
== 0                            ; is restored exactly

>> b2: real/to-matrix b1 4      ; convert to 4x4 matrix
== [[1 1.4142135623731 1.73205080756888 2] [2.23606797749979 ...
>> real/write %test.bin b2
16 decimal values written       ; the same values are written,
>> bb2: real/read %test.bin     ; and read back into a flat block
== [1 1.4142135623731 1.73205080756888 2 2.23606797749979 ...
}

write: func [
    {Writes a (nested) block of decimal values
    to a file in native binary format}
    f [file!]          "file to write to"
    b [block! number!] "number or block of numbers"
    /rev               "reverse bytes if needed"
    /append            "append to file"
    /local out elem p to-do
][
    out: copy #{}
    to-do: copy []
    insert to-do b
    nat: to path! either rev [[to-native rev]][[to-native]]
    while [ not tail? to-do ] [
        either block? first to-do [
            change/part to-do first to-do 1
        ][
            insert tail out nat first to-do
            remove to-do
        ]
    ]
    either append [
        system/words/write/binary/append f out
    ][
        system/words/write/binary f out
    ]
    print [(length? out) / 8  "decimal values written"]
]

read: func [
    {Returns a block of numbers read in from a binary data file}
    f "file name of binary file"
    /rev "reverse bytes if needed"
    /local tmp out from l
][
    tmp: system/words/read/binary f
    l: (length? tmp) / 8
    if not zero? l - to integer! l
        [make error! "read-native: bad file size"]
    out: make block! l
    from: make path! either rev [[from-native rev]][[from-native]]
    loop l [
        insert tail out from copy/part tmp 8
        tmp: skip tmp 8
    ]
    out
]

comment { =============== REAL/SPLIT ===============

SPLIT calculates the three components of the IEEE representation of a
double floating point value. These are the actual values used by the CPU
in numerical calculations.

>> set [sign exponent fraction] real/split pi
== [0 1024 2.57063812465794E+15]
>> (-1 ** sign) * (2 ** (exponent - 1023)) * (1 + (fraction * (2 ** -52)))
== 3.14159265358979

Numbers smaller than 2 ** -1022 (denormals, which have an exponent
component of zero) use a different formula:

>> set [sign exponent fraction] real/split probe 2 ** -1030
8.69169475979376E-311
== [0 0 17592186044416]
>> (-1 ** sign) * (2 ** -1074) * fraction
== 8.69169475979376E-311
}

split: func [
    "Returns block containing three components of double floating point value"
    x [number!] /local sign exponent fraction
][
    sign: either negative? x [x: (- x) 1][0]

    either zero? x [exponent: 0  fraction: 0][

        either zero? 1024 - exponent: to integer! log-2 x [exponent: 1023][
            if positive? (2 ** exponent) - x [exponent: exponent - 1]
        ]
        fraction: x / (2 ** exponent)

        either positive? exponent: exponent + 1023 [
            fraction: fraction - 1         ; drop the first bit for normals
            fraction: fraction * (2 ** 52) ; make the remaining fraction an
                                           ; "integer"
        ][
            fraction: 2 ** (51 + exponent) * fraction  ; denormals
            exponent: 0
        ]
    ]
    reduce [sign exponent fraction]
]

split32: func [
    "Returns block containing three components of double floating point value"
    x [number!] /local sign exponent fraction
][
    sign: either negative? x [x: (- x) 1][0]

    either zero? x [exponent: 0  fraction: 0][

        either zero? 128 - exponent: to integer! log-2 x [exponent: 127][
            if positive? (2 ** exponent) - x [exponent: exponent - 1]
        ]
        fraction: x / (2 ** exponent)

        either positive? exponent: exponent + 127 [
            fraction: fraction - 1         ; drop the first bit for normals
            fraction: fraction * (2 ** 23) ; make the remaining fraction an
                                           ; "integer"
        ][
            fraction: 2 ** (22 + exponent) * fraction  ; denormals
            exponent: 0
        ]
        fraction: to integer! fraction + .5
    ]
    reduce [sign exponent fraction]
]
comment { =============== REAL/CONVERT REAL/RESTORE ===============

These functions are principally meant to be used by REAL/SAVE and
REAL/LOAD. REAL/CONVERT accepts a value of any SAVE-able datatype,
converts all decimal values to native binaries, and returns the
result. The argument value is unaffected. REAL/RESTORE does the
reverse of REAL/CONVERT, restoring all of the original decimal
values. This allows decimal values to be saved with no roundoff error.

Since all object and any-block values are copied, the result of
converting and restoring may not be identical to the original value.
The result will be good enough, however, to allow saving and
loading of values compatible with the behavior of the standard
functions SAVE and LOAD, and without any roundoff error.

EXAMPLE:

>> circle-area: func [r [number!]] compose [(pi) * r * r]
>> probe obj1: make object! compose/deep [
[    a: [(pi) (exp 1)] b: (EU$1.00 * pi) c: real/to-native (pi)
[    f: :circle-area ]

make object! [
    a: [3.14159265358979 2.71828182845905]
    b: EU$3.14
    c: #{400921FB54442D18}
    f: func [r [number!]][3.14159265358979 * r * r]
]

>> probe obj2: real/convert obj1

make object! [
a: [#{400921FB54442D18} #{4005BF0A8B145769}]
b: (EU$1.00 * #{400921FB54442D18})   ; money value converted to paren
c: ['escape #{400921FB54442D18}]     ; pre-existing 8-byte binary is escaped
f: func [r [number!]][#{400921FB54442D18} * r * r]
]
>> probe obj3: real/restore obj2

make object! [
a: [3.14159265358979 2.71828182845905]
b: EU$3.14
c: #{400921FB54442D18}
f: func [r [number!]][3.14159265358979 * r * r]
]

>> obj3/a/1 - pi                   ; decimal values are exactly restored
== 0
>> (obj3/f 4) - circle-area 4      ; restored function gives same answer
== 0

}

convert: func [
    {returns (copy of) B with all decimals converted to binary natives}
    value     "value to convert"
    /local r
][
    if function? :value [
        return func load mold third :value convert second :value
    ]
    if object? :value [
        r: make value []
        foreach word next first r [
            set in r word convert get in r word
        ]
        return r
    ]
    if any-block? :value [
        r: copy :value
        while [not tail? :r] [
            change/only :r convert first :r
            r: next :r
        ]
        return head :r
    ]
    if money? :value [
        return to paren! compose [(value / value/2) * (to-native value/2)]
    ]
    if all [
        binary? :value
        8 = length? value
    ][                            ; return an "escaped" form
        return compose ['escape (value)]
    ]
    if :value = first ['escape] [
        return ['escape 'escape]
    ]
    either decimal? :value [to-native value][:value]
]

restore: func [
    {returns (copy of) B with all binary natives converted to decimals}
    value     "value to convert"
    /local r item
][
    if function? :value [
        return func load mold third :value restore second :value
    ]
    if object? :value [
        r: make value []
        foreach word next first r [  ; cycle through all words except first
            set in r word restore get in r word
        ]
        return r
    ]
    if any-block? :value [
        if all [
            paren? :value
            3 = length? :value
            money? first :value
            binary? item: pick :value 3
        ][                        ; restore a money value
            change at :value 3 from-native item
            return value
        ]
        if all [
            block? :value
            2 = length? value
            (first value) = (first ['escape])
        ][
            return second value   ; return the "escaped" value
        ]
        r: copy :value
        while [not tail? :r] [
            change/only :r restore first :r
            r: next :r
        ]
        return head :r
    ]
    either all [
        binary? :value
        8 = length? value
    ][from-native value][:value]
]

comment { =============== TO-BIN FROM-BIN ===============

NOTE: used by REAL/SHOW and REAL/FROM-NATIVE

}

to-bin: func [
    {return a binary string representation of N}
    n [number!] "number to show in binary (integer value from 0 to 2 ** 53)"
    /length l   "length of string desired"
    /local r v
][
    if not l [l: 1]
    either negative? n - 1 [r: copy "0"][
        r: copy ""
        v: 2 ** to integer! log-2 n
        if negative? n - v [v: v / 2]  ; in case LOG-2 rounds up
        while [ v >= 1 ] [
            insert tail r either negative? n - v ["0"][n: n - v "1"]
            v: v / 2
        ]
    ]
    head insert/dup r "0" (l - length? r)
]

from-bin: func [
    {convert a binary string representation into a numeric value}
    b [string!]
    /local x  bitval
][
    bitval: 1.0
    b: tail b
    x: 0
    while [ not head? b ] [
        b: back b
        if #"1" = first b [x: x + bitval]
        bitval: bitval * 2
    ]
    x
]

comment { =============== TO-MATRIX ===============

EXAMPLE:

>> to-matrix [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16] 4
== [[1 2 3 4] [5 6 7 8] [9 10 11 12] [13 14 15 16]]
>> to-matrix [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16] [2 4]
== [[[1 2 3 4] [5 6 7 8]] [[9 10 11 12] [13 14 15 16]]]

}

to-matrix: func [
    {Returns a matrix constructed from the values of B}
    b [block!]
    row-length [number! block!]
    /local out number-rows
][
    if number? row-length [row-length: reduce [row-length]]
    reverse row-length
    number-rows: length? b
    foreach l row-length [
        number-rows: number-rows / l
        if not zero? number-rows - to integer! number-rows
            [make error! "to-matrix: bad dimensions"]
        out: make block! number-rows
        loop number-rows [
            insert/only tail out copy/part b l
            b: skip b l
        ]
        b: out
    ]
    out
]

]  ; end REAL

comment { =============== IEEE ===============

IEEE is an object that contains:

REBTEST   A function that tests the sensitivity of the REBOL EQUAL?
          comparison function.
GET-NEXT  A function that makes the minimum increment to a decimal value.
GET-LAST  A function that makes the maximum decrement to a decimal value.
MAX-REAL  The largest decimal value.
MIN-NORM  The smallest positive normalized decimal.
MIN-REAL  The smallest positive decimal value.
EPS       The minimum increment to 1 (smallest x such that (x+1)>1).

All of the increments and other values in IEEE are calculated based on
IEEE Std 754 (International Electrical and Electronic Engineering society).

REBTEST points out the inexactness of the REBOL comparison functions (as of
version 2.2), but note that it is easy to get exact comparisons by using
ZERO? NEGATIVE? and POSITIVE? to test the results of subtraction:

>> x: .1
== 0.1
>> y: ieee/get-next .1     ; make minimum increment to .1
== 0.1
>> y - x
== 1.38777878078145E-17    ; Y is greater than X ...
>> equal? x y
== true                    ; inexact
>> zero? x - y
== false                   ; exact
>> greater? y x
== false
>> positive? y - x
== true
>> lesser? x y
== false
>> negative? x - y
== true

; Example of rebtest (format.r not loaded so we get REBOL display values)
; Let's use 2 ** 53 as the target. All positive integers from 1 to 2 ** 53
; are exact in binary form. All doubles greater than 2 ** 52 are integers.
; The doubles from 2 ** 52 thru 2 ** 53 are consecutive integers.
; The first column shows the result of REBOL's test for equality of the target
; to (target + increment). The 2nd column shows REBOL display value and the
; 3rd column shows the increment.

>> ieee/rebtest 2 ** 53             ; the exact value is 9007199254740992
target 9.00719925474099E+15         ; REBOL display rounds to 15 sig. digits
positive increments
t=t+i target+increment increment
true 9.00719925474099E+15 2         ; positive increments are of size 2
true 9.007199254741E+15 4         ; REBOL display value changes
true 9.007199254741E+15 6         ; REBOL equality test is wrong
true 9.007199254741E+15 8
true 9.007199254741E+15 10
true 9.007199254741E+15 12
true 9.00719925474101E+15 14     ; REBOL display changes again
true 9.00719925474101E+15 16     ; but equality test is still wrong
false 9.00719925474101E+15 18     ; equality test correct once we add 18
false 9.00719925474101E+15 20
negative increments
t=t+i target+increment increment
false 9.00719925474099E+15 -1    ; negative increments are of size 1
false 9.00719925474099E+15 -2
false 9.00719925474099E+15 -3
false 9.00719925474099E+15 -4
false 9.00719925474099E+15 -5
false 9.00719925474099E+15 -6     ; REBOL equality test OK for all inc.
false 9.00719925474099E+15 -7
false 9.00719925474098E+15 -8     ; REBOL display changes
false 9.00719925474098E+15 -9
false 9.00719925474098E+15 -10

}

IEEE: make object! [

comment { =============== IEEE/REBTEST ===============

REBTEST makes ten successive minimum increments and decrements to the
target value, and tests whether EQUAL? returns TRUE when comparing
the results to the original value. In all cases EQUAL? should return
false.

}

rebtest: func [
     {displays 21 adjacent doubles centered on x}
     x [number!] "target value"
     /local y
][
    print ["target"  x ]
    print "positive increments"
    print ["t=t+i"  "target+increment"  "increment"]
    y: x
    loop 10 [
        if all [positive? y  zero? y - max-real][
            print ["" "+Inf"]
            break
        ]
        y: get-next y
        print [equal? x y  y  y - x]
    ]
    print "negative increments"
    print ["t=t+i"  "target+increment"  "increment"]
    y: x
    loop 10 [
        if all [negative? y  zero? y + max-real][
            print ["" "-Inf"]
            break
        ]
        y: get-last y
        print [equal? x y  y  y - x]
    ]
]

get-next: func [
    {returns next double after x}
    x [number!] "input value"
    /local exp inc
][
    if zero? x [return 2 ** -1074]
    if negative? x [return - get-last (- x)]
    either zero? 1024 - exp: to-integer log-2 x [exp: 1023][
        if positive? (2 ** exp) - x [exp: exp - 1]
    ]
    inc: 2 ** (exp - 52)                ; local machine precision
    if exp < -1021 [inc: 2 ** -1074]    ; handle denormals
    x + inc
]

get-last: func [
    {returns next double before x}
    x [number!] "input value"
    /local exp inc
][
    if zero? x [return - (2 ** -1074)]
    if negative? x [return - get-next (- x)]
    either zero? 1024 - exp: to-integer log-2 x [exp: 1023][
        if not negative? (2 ** exp) - x [exp: exp - 1]
    ]
    inc: 2 ** (exp - 52)                ; local machine precision
    if exp < -1021 [inc: 2 ** -1074]    ; handle denormals
    x - inc
]

max-real: 2 ** 1023 * (2 - (2 ** -52))   ; maximum decimal value

min-norm: 2 ** -1022         ; minimum normalized positive value

min-real: 2 ** -1074         ; minimum positive decimal value

eps: 2 ** -52   ; machine epsilon (smallest x such that (x+1)>1)

; if possible, set PRINT locally to a function providing formatted output

print: either value? 'format [
    func [line][
        system/words/print format/full reduce line [#8..3 #24.16.1 #12.2.1]
    ]
][
    get in system/words 'print
]

] ; end IEEE

comment { =============== EMPIRICAL ===============

EMPIRICAL is equivalent to IEEE, but whereas the values in IEEE are
calculated based on the IEEE standard, the values in EMPIRICAL are
obtained through an empirical algorithm. The function CMP-SENS does
this by actually trying a series of increments to the target value,
until the smallest value is identified that results in a different
value when added to the target.

}

empirical: make object! [

cmp-sens: func [
    {find smallest effective increment for TARGET.
    NOTE: this is less than the resulting increment}
    target [number!]
    /exact   {results for exact comparison - default is use EQUAL?}
    /below   "return decrement (default is increment)"
    /local diff upper lower last-diff eqf operation no-effect
][
    eqf: either exact [func[x y][zero? x - y]][:equal?]
    operation: either below [ :subtract ][ :add ]
    last-diff: upper: max   2 ** -30   abs target * (2 ** -30)
    lower: 0
    diff:  upper + lower / 2
    while [ not zero? last-diff - diff ] [
        last-diff: diff
        if error? try [
            no-effect: eqf target operation target diff
        ][
            no-effect: none
        ]
        either no-effect [
            lower: diff
            diff: diff + upper / 2
        ][
            upper: diff
            diff: diff + lower / 2
        ]
    ]
    return either none? no-effect [none][upper]
]

rebtest: func [
    {compare sensitivity of REBOL comparison operators against
    actual increment value}
    target [number!]
    /local inc rebsense factor
][
    if inc: cmp-sens/exact target [             ; get effective increment
        inc: target + inc - target              ; get resulting increment
        if rebsense: cmp-sens target [
            rebsense: target + rebsense - target
            if 1e10 < factor: rebsense / inc [factor: form factor]
        ]
    ]
    print ["Increments:"  "Smallest" "NOT EQUAL?" "Factor"]
    print ["Positive:" inc  rebsense factor]
    factor: none
    if inc: cmp-sens/below/exact target [
        inc: target - inc - target
        if rebsense: cmp-sens/below target [
            rebsense: target - rebsense - target
            if 1e10 < factor: rebsense / inc [factor: form factor]
        ]
    ]
    print ["Negative:" inc rebsense factor]
]

get-next: func [
    {make the smallest possible increment to a double}
    target [number!]
    /count n "number of times to do this"
][
    if not n [n: 1]
    loop n [
        target: target + cmp-sens/exact target
    ]
]

get-last: func [
    {make the smallest possible decrement to a double}
    target [number!]
    /count n "number of times to do this"
][
    if not n [n: 1]
    loop n [
        target: target - cmp-sens/below/exact target
    ]
]

max-real: func [
    {returns the highest numerical value on the system}
    /local x lower upper factor last-factor
][
    x: 2.0
    loop 100000 [
        if error? try [x: x * 2][break]
    ]
    lower: 1
    upper: 2
    last-factor: 0
    loop 100000 [
        if zero? last-factor - factor: lower + upper / 2 [break]
        either error? try [x * factor] [upper: factor][lower: factor]
        last-factor: factor
    ]
    x * lower
]

min-real: get-next 0

eps: (get-next 1) - 1

print: either value? 'format [
    func [
        {print out a formatted line if FORMAT is available}
        line
    ][
        system/words/print format/full reduce line
            [#-12 #12.2.1 #12.2.1 #8]
    ]
][
    get in system/words 'print
]

]  ; end empirical