text:
library(tidyverse)
library(data.table)

## rich medium ####
dishort <- disome.ori[disome.ori$seqlen %in% 53:54, ]

table(dishort$rep)
# 1    2
# 5547 3693
dishort[, c('sequnum', 'frame3', 'putative', 'region', 'dupl')] <- NULL
rownames(dishort) <- NULL

dishort$rawlen <- dishort$seqlen
dishort$seqlen <- dishort$rawlen + 5

dishort$cor.pos <- correct.pos(dishort)
dishort$asite <- get.asite(dishort)

dishort.peak <- dishort %>% group_by(rep, gene, asite) %>%
  summarise(read=sum(seqsnum)) %>% ungroup()
dishort.peak$rep <- paste0('r', dishort.peak$rep)
dishort.peak <- dishort.peak %>% spread(rep, read)
dishort.peak[is.na(dishort.peak)] <- 0
dishort.peak$read <- rowSums(dishort.peak[, c('r1', 'r2')])

dishort.peak <- merge(dishort.peak, cds.len, by='gene', all.x=T)
dishort.peak$sc <- ifelse(dishort.peak$len-3 == dishort.peak$asite, 1, 0)
dishort.peak$sc[dishort.peak$asite > dishort.peak$len-3] <- -1
dishort.peak$peakshare <- ifelse(dishort.peak$r1>0 & dishort.peak$r2>0, 1, 0)
dishort.peak$rpm1 <- dishort.peak$r1 / (sum(dishort.peak$r1)/1e6)
dishort.peak$rpm2 <- dishort.peak$r2 / (sum(dishort.peak$r2)/1e6)
dishort.peak$rpm <- rowMeans(dishort.peak[, c('rpm1', 'rpm2')])
dishort.peak <- dishort.peak %>% group_by(gene) %>%
  mutate(rpm.nor=rpm/sum(rpm)) %>% as.data.frame()

dishort.peak$asite.perc <- dishort.peak$asite / (dishort.peak$len-3)
dishort.peak$len <- NULL

length(unique(dishort.peak$gene))
# [1] 1876

{
  pdf('P3_5354nt_asite_nor.pdf', width = 2.2, height = 1.2)
  plot(
    ggplot(dishort.peak, aes(x=asite.perc, weight=rpm.nor/(1876/100)))+
      geom_freqpoly(binwidth=0.01, color='#FF9900')+theme_classic()+
      # geom_vline(xintercept = 1)+
      theme(axis.title = element_text(size=8, color='black'),
            axis.text = element_text(size=8, color='black'),
            axis.line = element_line(color='black'),
            axis.ticks = element_line(color='black'),
            legend.position = 'none')+
      xlab('Relative position on CDS')+ylab('Density')+
      scale_x_continuous(breaks = c(0, 0.5, 1), limits = c(-0.1, 1.1),
                         labels = c('Start', '50%', 'Stop'))
  )
  dev.off()
}

dishort.asite <- dishort.peak[, c('gene', 'asite', 'r1', 'r2', 'read', 'sc', 'peakshare')]
dishort.asite$aaseq <- peak.seq(dishort.asite, 'exit', 4, asite=T)
dishort.asite$codonseq <- peak.seq(dishort.asite, 'exit', 4, aa=F, asite=T)
dishort.asite <- dishort.asite[dishort.asite$sc != -1, ]

#### asite
# bgmrna.asite.codon.read <- enrich.posi('p4', diasite.codon.read, mrnaasite.codon.read, overlapgene=F, codon=T)
dshortasite.codon.read <- count_site(dishort.asite, 'codonseq', 1, aa=F, count_read=T)
bgmrna.ds.asite.codon.read <- enrich.posi('p4', dshortasite.codon.read, mrnaasite.codon.read, overlapgene=F, codon=T)

vsrich58.rich53.46 <- merge(bgmrna.ds.asite.codon.read[, c('mer', 'genenum', 'oddsratio', 'pvalue'),],
                            bgmrna.asite.codon.read[, c('mer', 'genenum', 'oddsratio', 'pvalue', 'optimality'),],
                            by=c('mer'), all=T, suffixes=c('.rich53', '.rich58'))
vsrich58.rich53.46 <- vsrich58.rich53.46[vsrich58.rich53.46$mer != '   ',]

vsr58.r53.a46.cor <- cor.test(vsrich58.rich53.46[!vsrich58.rich53.46$mer %in% c('TAA', 'TGA', 'TAG'),]$oddsratio.rich53,
                              vsrich58.rich53.46[!vsrich58.rich53.46$mer %in% c('TAA', 'TGA', 'TAG'),]$oddsratio.rich58,
                              method = 's')

{
  pdf('P3_rich53vsrich58.pdf', width = 2.4, height = 2.63, useDingbats = F)
  plot(
    ggplot(vsrich58.rich53.46,
           aes(x=log2(oddsratio.rich58), y=log2(oddsratio.rich53),
               color=optimality))+
      geom_point(size=1)+theme_classic()+
      geom_text(data=vsrich58.rich53.46[vsrich58.rich53.46$mer %in% c('TAG', 'TAA', 'TGA'),],
                aes(label=mer))+
      geom_abline(slope = 1, intercept = 0, linetype='dashed', color='grey')+
      xlim(-5, 6)+ylim(-5, 6)+
      labs(title='Disome, rich 58nt vs rich 53nt, 46-48nt asite')+
      scale_color_manual(values=c('black', '#3399ff'))+
      theme(axis.title = element_text(size=8, color='black'),
            axis.text = element_text(size=8, color='black'),
            axis.line = element_line(color='black'),
            axis.ticks = element_line(color='black'),
            legend.position = 'none')+
      xlab('Log2(A-site pausing score), 58nt, rich')+
      ylab('Log2(A-site pausing score), 53nt, rich')+
      annotate('text', x=-3, y=4,
               label=sprintf('rho = %.2f\nP = %.2e\nN = 61',
                             vsr58.r53.a46.cor$estimate,
                             vsr58.r53.a46.cor$p.value))
  )
  dev.off()
}

dspaa.aa.read.rmsc <- count_site(dishort.asite[dishort.asite$sc == 0, ], 'aaseq', 1, aa=T, count_read=T)
bgmrna.dspaa.read <- enrich.posi('p3', dspaa.aa.read.rmsc, mrnaasite.aa.read.rmsc, overlapgene=F, codon=F)

vsrich58.rich53.psite <- merge(bgmrna.psite.aa.read.rmsc[, c('mer', 'genenum', 'oddsratio', 'pvalue'),],
                               bgmrna.dspaa.read[, c('mer', 'genenum', 'oddsratio', 'pvalue'),],
                            by=c('mer'), all=T, suffixes=c('.rich58', '.rich53'))
vsrich58.rich53.psite <- vsrich58.rich53.psite[vsrich58.rich53.psite$mer != ' ',]
vsr58.r53.paa.cor <- cor.test(log2(vsrich58.rich53.psite$oddsratio.rich58),
                              log2(vsrich58.rich53.psite$oddsratio.rich53), method = 's')

{
  pdf('P3_rich53vsrich58_psite.pdf', width = 2.4, height = 2.63, useDingbats = F)
  plot(
    ggplot(vsrich58.rich53.psite,
           aes(log2(oddsratio.rich58), log2(oddsratio.rich53)))+
      theme_classic()+
      geom_point(size=1)+theme_classic()+
      geom_text(data=vsrich58.rich53.psite[vsrich58.rich53.psite$mer == 'P',],
                aes(label=mer))+
      geom_abline(slope = 1, intercept = 0, linetype='dashed', color='grey')+
      xlim(-0.83, 1.432)+ylim(-0.83, 1.432)+
      labs(title='Disome, rich 58nt vs rich 53nt, Psite')+
      scale_color_manual(values=c('black', '#3399ff'))+
      theme(axis.title = element_text(size=8, color='black'),
            axis.text = element_text(size=8, color='black'),
            axis.line = element_line(color='black'),
            axis.ticks = element_line(color='black'),
            legend.position = 'none')+
      xlab('Log2(P-site pausing score), 58nt, rich')+
      ylab('Log2(P-site pausing score), 53nt, rich')+
      annotate('text', x=-0.5, y=1.3,
               label=sprintf('rho = %.2f\nP = %.2e\nN = 20',
                             vsr58.r53.paa.cor$estimate,
                             vsr58.r53.paa.cor$p.value))
  )
  dev.off()
  }

## 3at ####
di3atshort <- di.3at.ori[di.3at.ori$seqlen %in% 53:54,]
table(di3atshort$rep)
# 1    2
# 3331 3028

di3atshort[, c('sequnum', 'frame3', 'putative', 'region', 'dupl')] <- NULL
rownames(di3atshort) <- NULL

di3atshort$rawlen <- di3atshort$seqlen
di3atshort$seqlen <- di3atshort$rawlen + 5

di3atshort$cor.pos <- correct.pos(di3atshort)
di3atshort$asite <- get.asite(di3atshort)

di3atshort.peak <- di3atshort %>% group_by(rep, gene, asite) %>%
  summarise(read=sum(seqsnum)) %>% ungroup()
di3atshort.peak$rep <- paste0('r', di3atshort.peak$rep)
di3atshort.peak <- di3atshort.peak %>% spread(rep, read)
di3atshort.peak[is.na(di3atshort.peak)] <- 0
di3atshort.peak$read <- rowSums(di3atshort.peak[, c('r1', 'r2')])

di3atshort.peak <- merge(di3atshort.peak, cds.len, by='gene', all.x=T)
di3atshort.peak$sc <- ifelse(di3atshort.peak$len-3 == di3atshort.peak$asite, 1, 0)
di3atshort.peak$sc[di3atshort.peak$asite > di3atshort.peak$len-3] <- -1
di3atshort.peak$peakshare <- ifelse(di3atshort.peak$r1>0 & di3atshort.peak$r2>0, 1, 0)

di3atshort.peak$len <- NULL

di3atshort.asite <- di3atshort.peak
di3atshort.asite$aaseq <- peak.seq(di3atshort.asite, 'exit', 4, asite=T)
di3atshort.asite$codonseq <- peak.seq(di3atshort.asite, 'exit', 4, aa=F, asite=T)
di3atshort.asite <- di3atshort.asite[di3atshort.asite$sc != -1, ]

ds3at.acodon.read <- count_site(di3atshort.asite, 'codonseq', 1, aa=F, count_read=T)
bgmrna.ds3at.acodon.read <- enrich.posi('p4', ds3at.acodon.read, mrnaasite.3at.codon.read, overlapgene=F, codon=T)

vs3at.5358 <- merge(bgmrna.ds3at.acodon.read[, c('mer', 'genenum', 'oddsratio', 'pvalue', 'optimality'),],
                    bgmrna.3at.asite.codon.read[, c('mer', 'genenum', 'oddsratio', 'pvalue'),],
                    by=c('mer'), all=T, suffixes=c('.53', '.58'))
vs3at.5358 <- vs3at.5358[vs3at.5358$mer != '   ',]

{
  pdf('P3_3AT53vs3AT58.pdf', width = 2.4, height = 2.65, useDingbats = F)
  plot(
    ggplot(vs3at.5358, aes(x=log2(oddsratio.58), y=log2(oddsratio.53),
                           color=optimality))+
      geom_point(size=1)+theme_classic()+
      geom_text(data=vs3at.5358[vs3at.5358$mer %in% c('CAT', 'CAC', 'TAG', 'TAA', 'TGA'),],
                aes(label=mer))+
      geom_abline(slope = 1, intercept = 0, linetype='dashed', color='grey')+
      xlim(-5, 6)+ylim(-5, 6)+labs(title='Disome, 3at 58nt vs 53nt')+
      # theme(axis.title = element_text(size=8, color='black'),
      # axis.text = element_text(size=8, color='black'),
      # axis.line = element_line(color='black'))+
      xlab('Log2(A-site pausing score), 58nt, 3-AT')+
      ylab('Log2(A-site pausing score), 53nt, 3-AT')+
      scale_color_manual(values=c('black', '#3399ff'))+
      theme(axis.title = element_text(size=8, color='black'),
            axis.text = element_text(size=8, color='black'),
            axis.line = element_line(color='black'),
            axis.ticks = element_line(color='black'),
            legend.position = 'none')
  )
  dev.off()
}

## the end ####

max_stars_repo_name: mingming-cgz/Disome-seq

max_issues_repo_name: mingming-cgz/Disome-seq

max_forks_repo_name: mingming-cgz/Disome-seq


text:
=begin
  # sample-primefield01.rb

  require "algebra"
  Z13 = ResidueClassRing(Integer, 13)

  a, b, c, d, e, f, g = Z13
  p [e + c, e - c, e * c, e * 2001, 3 + c, 1/c, 1/c * c, d / d, b * 1 / b]
    #=> [6, 2, 8, 9, 5, 7, 1, 1, 1]
  p( (1...13).collect{|i|  Z13[i]**12} )
    #=> [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
((<_|CONTENTS>))
=end

ext: rd

max_issues_repo_name: rubyworks/stick


text:
REBOL [
    Title: "R2-forward"
    Date: 21-Jul-2011/11:25:07+2:00
    Name: none
    Version: none
    File: none
    Home: none
    Author: "Oldes"
    Owner: none
    Rights: none
    Needs: none
    Tabs: none
    Usage: none
    Purpose: none
    Comment: none
    History: none
    Language: none
    Type: none
    Content: none
    Email: none
]

;object: :context

funct: func [
    "Defines a function with all set-words as locals."
    [catch]
    spec [block!] {Help string (opt) followed by arg words (and opt type and string)}
    body [block!] "The body block of the function"
    /with "Define or use a persistent object (self)"
    object [object! block!] "The object or spec"
    /extern words [block!] "These words are not local"
    /local r ws wb a
][
    spec: copy/deep spec
    body: copy/deep body
    ws: make block! length? spec
    parse spec [any [
            set-word! | set a any-word! (insert tail ws to-word a) | skip
        ]]
    if with [
        unless object? object [object: make object! object]
        bind body object
        insert tail ws first object
    ]
    insert tail ws words
    wb: make block! 12
    parse body r: [any [
            set a set-word! (insert tail wb to-word a) |
            hash! | into r | skip
        ]]
    unless empty? wb: exclude wb ws [
        remove find wb 'local
        unless find spec /local [insert tail spec /local]
        insert tail spec wb
    ]
    throw-on-error [make function! spec body]
]

ext: r

max_stars_repo_name: Oldes/rs

max_issues_repo_name: Oldes/rs

max_forks_repo_name: Oldes/rs


text:
# Databricks notebook source
library(SparkR)

# COMMAND ----------

df <- createDataFrame(faithful)
# Displays the content of the DataFrame to stdout
head(df)

# COMMAND ----------

# From Data Sources using Spark SQL
diamondsDF <- read.df("/databricks-datasets/Rdatasets/data-001/csv/ggplot2/diamonds.csv",
                    source = "csv", header="true", inferSchema = "true")
head(diamondsDF)

# COMMAND ----------

# SparkR automatically infers the schema from the CSV file.
printSchema(diamondsDF)

# COMMAND ----------

display(diamondsDF)

# COMMAND ----------

#  Let's use spark-avro package to load an Avro file.
# First take an existing data.frame, convert to SparkDataFrame and save it as an Avro file.
irisDF <- createDataFrame(iris)
write.df(irisDF, source = “com.databricks.spark.avro”, path = “dbfs:/tmp/iris.avro”, mode = “overwrite”)

# COMMAND ----------


text:
context("Write file")

library(ggplot2)

source("reference.r")

test_that("Basic R Markdown file creation.", {
  cc_list <- list(
    Linear = ggplot(anscombe, aes(x = x1, y = y1)) + geom_point(),
    `Non Linear` = ggplot(anscombe, aes(x = x2, y = y2)) + geom_point(),
    `Outlier Vertical` = ggplot(anscombe, aes(x = x3, y = y3)) + geom_point(),
    `Outlier Horizontal` = ggplot(anscombe, aes(x = x4, y = y4)) + geom_point(),
    a = list(b = 3, 4))

  rds_file <- "cc-list.rds"
  saveRDS(cc_list, file = rds_file)

  ld <- listdown(load_cc_expr = readRDS("cc-list.rds"), package = "ggplot2")

  ld_write_file(
    ld_rmarkdown_header(title = "The Anscombe Quartet",
                        author = "Francis Anscombe",
                        date = "1973"),
    ld,
    "anscombe-quartet.rmd")

  if (make_reference) {
    ld_write_file(
      ld_rmarkdown_header(title = "The Anscombe Quartet",
                          author = "Francis Anscombe",
                          date = "1973"),
      ld,
      file.path("reference-data", "anscombe-quartet.rmd"))
  }

  expect_equal(readLines("anscombe-quartet.rmd"),
               readLines(file.path("reference-data", "anscombe-quartet.rmd")))

  unlink("anscombe-quartet.rmd")
  unlink("cc-list.rds")
})

test_that("Basic R Markdown file errors.", {
  expect_error(
    ld_write_file(1:3, ld, file.path("reference-data", "anscombe-quartet.rmd")))

  expect_error(
    ld_write_file(ld_rmarkdown_header(title = "test"), 1:3, "bunk"))
})

max_stars_repo_name: joundso/listdown

max_issues_repo_name: joundso/listdown

max_forks_repo_name: joundso/listdown


text:
#' Confidence Interval function for the ATA Method
#'
#' @param object An \code{ATA} object is required.
#' @param ci.level Confidence level, for example: 90, 95 or 99.
#'
#' @return The confidence interval output for the ATA forecasts
#'
#' @importFrom stats qnorm qt sd ts tsp tsp<-
#'
#' @export
#'
ATA.CI <- function(object, ci.level = 95)
{
	ata.output <- object
		if (class(ata.output)!="ata"){
		return("The Input must be 'ata' object. Please use ATA function to produce 'ata' object. Calculation of Confidence Intervals of ATA Forecasts will terminate!")
	}
	ci.alpha <- 1 - (ci.level/100)
	length_resid <- length(ata.output$residuals[!is.na(ata.output$residuals)])
	if (length_resid<=30){
		ci.ZTvalue <- stats::qt(ci.alpha/2, df=length_resid)
	}else {
		ci.ZTvalue <- stats::qnorm(ci.alpha/2, lower.tail=FALSE)
	}
	std_resid <- sd(ata.output$residual, na.rm=TRUE)
	ci.value <- sqrt(1:ata.output$h) * abs(ci.ZTvalue) * std_resid
	tsp_F <- tsp(ata.output$forecast)
	forecast.lower <- ts(ata.output$forecast - ci.value, frequency = tsp_F[3], start = tsp_F[1])
	forecast.upper <- ts(ata.output$forecast + ci.value, frequency = tsp_F[3], start = tsp_F[1])
	my_list <- list("forecast"=ata.output$forecast, "forecast.lower"=forecast.lower, "forecast.upper"=forecast.upper)
	return(my_list)
}

max_stars_repo_name: cran/ATAforecasting

max_issues_repo_name: cran/ATAforecasting

max_forks_repo_name: cran/ATAforecasting


text:
library(dHRUM)
library(hydroGOF)
library(RcppDE)
library(data.table)

# 01	01181000	     WEST BRANCH WESTFIELD RIVER AT HUNTINGTON, MA	  42.23731	 -72.89565	    243.50
#test_1
#pathToCamel <- "/home/eleni/CULS_FES/dHRUM/basin_timeseries_v1p2_metForcing_obsFlow/basin_dataset_public_v1p2"

pathToCamel <- "/home/hubert/prg/data/basin_timeseries_v1p2_metForcing_obsFlow/basin_dataset_public_v1p2"
# pathToForcing <- "/basin_mean_forcing/maurer/"
# pathToForcing <-"/basin_mean_forcing/daymet/"
pathToForcing <- "/basin_mean_forcing/nldas/"
pathToObsQ <- "/usgs_streamflow/"

basinChrs <- fread(paste0(paste0(pathToCamel,"/basin_metadata/basin_physical_characteristics.txt")))
gaugeChars <- fread(paste0(paste0(pathToCamel,"/basin_metadata/gauge_informationPM.txt")))

gaugeChars[523:524,]

i <- 1
nt <- 2000
nseVec <- c()
kgeVec <- c()
for(i in 1:nrow(gaugeChars)){
  ifelse((gaugeChars$GAGE_ID[i]<10000000), gChrs <-paste0(0,gaugeChars$GAGE_ID[i]), gChrs <- paste0(gaugeChars$GAGE_ID[i]))
  ifelse((gaugeChars$HUC_02[i]<10), HUc <-paste0(0,gaugeChars$HUC_02[i],"/"), HUc <- paste0(gaugeChars$HUC_02[i],"/"))
  # dtaFC <- read.table(paste0(pathToCamel,pathToForcing,HUc,gChrs,"_lump_cida_forcing_leap.txt"), skip = 4)
  # dtaFC <- read.table(paste0(pathToCamel,pathToForcing,HUc,gChrs,"_lump_maurer_forcing_leap.txt"), skip = 4)
  dtaFC <- read.table(paste0(pathToCamel,pathToForcing,HUc,gChrs,"_lump_nldas_forcing_leap.txt"), skip = 4)
  dtaQ <- read.table(paste0(pathToCamel,pathToObsQ,HUc,gChrs,"_streamflow_qc.txt"))

  pr<-dtaFC$V6
  temp<-(dtaFC$V9+dtaFC$V10)/2

  area <- gaugeChars$`DRAINAGE_AREA_(KM^2)`[i] * 1000 * 1000
  lat <- gaugeChars$LAT[i]

  Qm <-dtaQ$V5 * 0.0283168466 * 3600 * 24/area*1000

  print(paste("The basin number: ",i))
  print(sum(pr[1:nt]))
  print(sum(Qm[1:nt]))

  nHrus <- 1
  IdsHrus <- paste0("ID_",0,gaugeChars$GAGE_ID[i])
  dhrus <- initdHruModel(nHrus,area,IdsHrus)

  setPTInputsToAlldHrus(dhrus, Prec = pr[1:nt], Temp = temp[1:nt], inDate = as.Date("1980/01/01"))
  calcPetToAllHrus(dHRUM_ptr = dhrus,Latitude = lat,"Hamon")

  ParDF = data.frame( B_SOIL = 1.6, C_MAX = 100, B_EVAP = 1,  KS = 0.01, KF = 0.03, ADIV = 0.8, CDIV = 0.3,
                    SDIV = 0.3, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.8, TETR = 0, DDFA = 0.75, TMEL = 0.0,
                    RETCAP = 10 )
  ParDFup = data.frame( B_SOIL = 2, C_MAX = 800, B_EVAP = 2,  KS = 0.4, KF = 0.7, ADIV = 0.9, CDIV = 0.3,
                      SDIV = 0.3, CAN_ST = 4., STEM_ST = 4., CSDIV = 0.8, TETR = 0.5, DDFA = 10, TMEL = 0.0,
                      RETCAP = 25 )
  ParDFlow = data.frame( B_SOIL = 1.3, C_MAX = 5, B_EVAP = 0.5,  KS = 0.002, KF = 0.2, ADIV = 0.01, CDIV = 0.05,
                       SDIV = 0.01, CAN_ST = 1., STEM_ST = 1., CSDIV = 0.01, TETR = -1, DDFA = 0.08, TMEL = -8.0,
                       RETCAP = 2 )

  ParBest = ParDF

  fitness = function(myPar){
    # myPar =ParDF[1,]
    setParamsToAlldHrus(dHRUM_ptr = dhrus,as.numeric(myPar),names(ParDF))
    # # for( i in 1:1000){
    calcHBInAlldHrus(dHRUM_ptr = dhrus)
    gatherHBdata(dHRUM_ptr = dhrus)
    # # }
    dta <- getOutput(dHRUM_ptr = dhrus)
    dF <-data.frame(dta$outDta)
    names(dF) <- dta$VarsNams
    # print((-1)*as.double(KGE(sim=dF$TOTR[365:nt],obs=Qm[365:nt])))
    sim=dF$TOTR[365:nt]
    obs=Qm[365:nt]
    myfitnes = sum((sim-obs)^2) / sum((obs- mean(obs))^2)
    # # mymae=NA
    # if(is.na(mymae)) mymae = 9999
    # (return as.double(mymae))
  }

  itermaxW=100
  decntr<-DEoptim.control(VTR = 0, strategy = 2, bs = FALSE, NP = 300,
                        itermax = itermaxW, CR = 0.75, F = 0.9, trace = FALSE,
                        initialpop = NULL, storepopfrom = itermaxW + 1,
                        storepopfreq = 1, p = 0.2, c = 0, reltol = sqrt(.Machine$double.eps),
                        steptol = itermaxW)
  u=DEoptim( lower=as.numeric(ParDFlow[1,]), upper=as.numeric(ParDFup[1,]), fn=fitness, control = decntr)
  ParBest[1,] = as.numeric(u$optim$bestmem)

  setParamsToAlldHrus(dHRUM_ptr = dhrus,as.numeric(ParBest[1,]),names(ParDF))

  calcHBInAlldHrus(dHRUM_ptr = dhrus)
  gatherHBdata(dHRUM_ptr = dhrus)

  dta <- getOutput(dHRUM_ptr = dhrus)
  dF <-data.frame(dta$outDta)
  names(dF) <- dta$VarsNams

  kgeVec[i] <- KGE(sim=dF$TOTR[365:nt],obs=Qm[365:nt])
  nseVec[i] <- NSE(sim=dF$TOTR[365:nt],obs=Qm[365:nt])
  plot(Qm[1:nt],dF$TOTR, main=paste(gaugeChars$GAGE_ID[i]," KGE=", format(kgeVec[i], digits = 2)," NSE=", format(nseVec[i], digits = 2)))
  plot(Qm[1:nt],type="l", main=paste(gaugeChars$GAGE_ID[i]," KGE=", format(kgeVec[i], digits = 2)," NSE=", format(nseVec[i], digits = 2))
       ,ylab ="Q [mm]", xlab="Time [day]")
  lines(dF$TOTR,col="red")
  grid()
}

boxplot(data.frame(KGE =kgeVec,NSE=nseVec))
KGE_NSE=data.frame(KGE =kgeVec,NSE=nseVec)
# saveRDS(file="/home/hubert/prg/data/outputs/NT_2000/camel_kge_nse_basic_2000cal_Daymet.rds",KGE_NSE)
# saveRDS(file="/home/hubert/prg/data/outputs/NT_2000/camel_kge_nse_basic_2000cal_Maurer.rds",KGE_NSE)
saveRDS(file="/home/hubert/prg/data/outputs/NT_2000/camel_kge_nse_basic_2000cal_nldas.rds",KGE_NSE)

dtKGdaymet <- readRDS("/home/hubert/prg/data/outputs/NT_2000/camel_kge_nse_basic_2000cal_Daymet.rds")
dtKGmauer <- readRDS("/home/hubert/prg/data/outputs/NT_2000/camel_kge_nse_basic_2000cal_Maurer.rds")
dtKGnldas <- readRDS("/home/hubert/prg/data/outputs/NT_2000/camel_kge_nse_basic_2000cal_nldas.rds")

#test_2
# dtKGdaymet <- readRDS("/home/eleni/Camels/camel_kge_nse_basic_2000cal_Daymet.rds")
# dtKGmauer <- readRDS("/home/eleni/Camels/camel_kge_nse_basic_2000cal_Maurer.rds")
# dtKGnldas <- readRDS("/home/eleni/Camels/NT_2000/camel_kge_nse_basic_2000cal_nldas.rds")

KGE = data.frame(KGEdaymet = dtKGdaymet$KGE, KGEmaurer = dtKGmauer$KGE, KGEnldas = dtKGnldas$KGE)
boxplot(KGE)
summary(KGE)

NSE = data.frame(NSEdaymet = dtKGdaymet$NSE, NSEmaurer = dtKGmauer$NSE, NSEnldas = dtKGnldas$NSE)
boxplot(NSE)
summary(NSE)

#
# plot(dF$TOTR, type='l')
# plot(dF$BASF, type='l')
# plot(dF$DIRR, type='l')
# plot(dF$SOIS, type='l')
# plot(dF$SURS,type= 'l')
# plot(dF$GROS, type='l')
# plot(dF$PREF,type= 'l')
# plot(dF$TROF,type= 'l')
# plot(dF$SNOW, type='l')
#
# plot(dF$CANS, type='l')
# plot(dF$STES, type='l')
#
# plot(dF$EVAC, type='l')
# plot(dF$EVAS, type='l')
# plot(dF$EVBS, type='l')
# plot(dF$AET, type='l')
#
#
# plot(Qm[1:nt],type="l")
# lines(dF$TOTR,col="red")

# plot(Qm[1:nt],dF$TOTR)

max_stars_repo_name: petrmaca/dHRUM

max_issues_repo_name: petrmaca/dHRUM

max_forks_repo_name: petrmaca/dHRUM


text:
################################################################ ASSIGNMENT# 1 POLITICAL ECONOMY #################################################################################################################
###############################################################       ANALYSIS STARTS            ##############################################################################################################################
##############################################################         READIND DATA ##############################################################################################################################################################

library(data.table)

file1 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/AE 2010.csv',skip = 1,header = T)
file2 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/AE_2008.csv',skip=4,header =T)
file3 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/AE2009_8913.csv',skip=1,header=T)
file4 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/AE2011.csv',skip=3,header=T)
file5 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/AE2012_8913.csv',skip=1,header=T)
file6 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/December 2013 LA election.csv',skip=2,header = T)
file7  = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/DECEMBER 2014 LA election.csv',skip =2,header=T)
file8 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/FEBRUARY- 2015 LA election.csv',skip = 3,header=T)
file9 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/LA (Nov) 2015.csv',skip=2,header = T)
file10 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/LA 2013.csv',skip=3,header = T)
file11 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/LA 2016.csv',skip=2,header = T)
file12 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/LA 2017.csv')
file13 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/MAY 2014 LA election.csv',skip=2,header = T)
file14 = fread('F:/Ashoka University/Semester 3/Political Economy/Assignments/Assignment_1/Data_CSV/OCTOBER 2014 LA election.csv',skip=2,header = T)

############################################################# READING DATA ENDS ##############################################################################################################################
######################################### MAKING THE COLUMNS UNIFORM, CLEANING THE DATA AND MERGING THE DATA ###################################################################################
file2 <- select(file2,-c(V16))
file2 <- na.omit(file2)
file8 <- na.omit(file8)
file11 <- na.omit(file11)
file12 <- na.omit(file12)
file13 <- na.omit(file13)
file8 <- select(file8,-c(V16:V23))
file6$DIST_NAME <- NA

colnames(file6)[12] <- "PARTYABBRE"
colnames(file6)[13] <- "TOTVOTPOLL"
colnames(file7)[14] <- "TOTVOTPOLL"
colnames(file8)[14] <- "TOTVOTPOLL"
colnames(file9)[14] <- "TOTVOTPOLL"
colnames(file10)[13] <- "PARTYABBRE"
colnames(file10)[14] <- "TOTVOTPOLL"
colnames(file11)[14] <- "TOTVOTPOLL"
colnames(file12)[14] <- "TOTVOTPOLL"
colnames(file13)[14] <- "TOTVOTPOLL"
colnames(file14)[14] <- "TOTVOTPOLL"

remove(Election_Data_1)
Election_Data_1 <- rbind(file1,file2,file3,file4,file5,file6,file7,file8,file9,file10,file11,file12,file13,file14)
Election_Data <- Election_Data_1
############################################################ DATASET CREATED ########################################################################################################################################

########################################################## ANALYSIS PART STARTED ######################################################################################################################################################3

#####################################################   CALCULATING VOTE SHARE OF THE CANDIDATES ###################################################################################################################################
Election_Data$TOTVOTPOLL = as.numeric(Election_Data$TOTVOTPOLL)

total_votes = Election_Data[,.(total_votes = sum(TOTVOTPOLL)),by=.(YEAR, ST_NAME,AC_NO)]

merged_dataset = merge(Election_Data, total_votes, by=c("YEAR", "ST_NAME", "AC_NO"))
merged_dataset$vote_share = (merged_dataset$TOTVOTPOLL / merged_dataset$total_votes)

# Election_Data_2 <- Election_Data_1[complete.cases(Election_Data_1)]
# total_votes_2 <- Election_Data_2[,.(total_votes_2=sum(TOTVOTPOLL)),by=.(YEAR,ST_NAME,AC_NO)]
# merged_dataset_2 <- merge(Election_Data_2,total_votes_2,by=c("YEAR","ST_NAME","AC_NO"))
# merged_dataset_2$vote_share <- (merged_dataset_2$TOTVOTPOLL/merged_dataset_2$total_votes_2)

################################################## CALCULATING WIN MARGIN OF THE CANDIDATES ###########################################################################################################################################

Election_Data_Win <- merged_dataset
winner_vote_share <- Election_Data_Win[,.(Winner_Vote= max(vote_share)),by=.(YEAR,ST_NAME,AC_NO)]
runner_up_vote_share <- Election_Data_Win[,.(Runner_Up_Vote =max(vote_share[vote_share != max(vote_share)])),by = .(YEAR,ST_NAME,AC_NO)]
merges_dataset_3 <- merge(Election_Data_Win,runner_up_vote_share,c("YEAR","ST_NAME","AC_NO"))
merges_dataset_3 <- merge(merges_dataset_3,winner_vote_share,c("YEAR","ST_NAME","AC_NO"))
merges_dataset_3$win_margin <- (merges_dataset_3$Winner_Vote - merges_dataset_3$Runner_Up_Vote)

################################################ CALCULATING CANDIDATE NUMBER FOR ELECTIONS IN A CONSTITUENCY ######################################################################################################################################
Election_Data_Win <- merges_dataset_3
num_candidates <- Election_Data_Win[,.(num_candidates = length(CAND_NAME)),by=.(YEAR,ST_NAME,AC_NO)]
merged_dataset_4 <- merge(Election_Data_Win,num_candidates,c("YEAR","ST_NAME","AC_NO"))
Final_Election_Data <- merged_dataset_4
###################################################### FINAL  DATASET CREATED #####################################################################################################################################################################################

######################################################### PLOTTING FIGURES ###############################################################################################################################################################################################
winner_vote_share <- na.omit(winner_vote_share)
runner_up_vote_share <- na.omit(runner_up_vote_share)

Winner_Voting_Margin <- cbind(winner_vote_share,runner_up_vote_share)
Winner_Voting_Margin$win_margin <- Winner_Voting_Margin$Winner_Vote - Winner_Voting_Margin$Runner_Up_Vote

Final_Election_Data <- Winner_Voting_Margin
Final_Election_Data <-   Final_Election_Data[-c(1414,1415,1416,4819,4820,4827,4828,4831,4832,4834,4835,4838,4839,4855,4823),]
Average_Win_Margin <- Final_Election_Data[,.(Average_Win_Margin = mean(win_margin)),by=.(YEAR)]

ggplot(Average_Win_Margin, aes(x = YEAR, y =Average_Win_Margin)) +
  geom_line( color = 'darkorange1',lwd = 1.5)+
  labs(
    x = "Years",
    y = "Average Win Margin",
    title = "Comparison of Win Margin in State Assembly Elections Over Years"

  ) +theme_bw()
############################################ PLOT_1 COMPLETED ######################################################################################################################################################################################
############################################ PLOT_2 STARTS #########################################################################################################################################################################################
num_candidates <- na.omit(num_candidates)
Average_Num_Candidates <- num_candidates[,.(Average_Num_Candidates = mean(num_candidates)),by=.(YEAR)]

ggplot(Average_Num_Candidates, aes(x = YEAR, y =Average_Num_Candidates)) +
  geom_line( color = 'darkorange1',lwd = 1.5)+
  labs(
    x = "Years",
    y = "Average Number of Candidates",
    title = "Comparison of Average Number of Candidates in State Assembly Elections Over Years in India"
    ) +theme_bw()

################################################ PLOT:2 COMPLETED #################################################################################################################################

################################################ DO-FILE ENDS #####################################################################################################################################


text:
REBOL [
    Title: "Requirements"
    Version: 1.0.0
    Rights: {
        Copyright 2015 Brett Handley
    }
    License: {
        Licensed under the Apache License, Version 2.0
        See: http://www.apache.org/licenses/LICENSE-2.0
    }
    Author: "Brett Handley"
    Purpose: {Specify and test requirements that code should meet.}
    ; This is the Rebol2 version.
]

; -------------------------------------------------------------------------------
;
; Each test can optionally begin with a string description of the requirement,
; stated in the positive sense (the requirement is met if the test returns true).
;
; This format should be compatible with Rebol test format.
;
; -------------------------------------------------------------------------------

throws-error: funct [
    condition [block!] {Bound to error object. Evaluated by ALL.}
    test [block!]
] [
    if error? set/any 'err try test [
        all bind/copy condition in disarm err 'type
    ]
]

user-error: funct [
    match [string! block!]
    test [block!]
] [
    if string? match [match: compose [(match) to end]]
    all [
        if error? set/any 'err try test [err: disarm err]
        string? err/arg1
        parse err/arg1 match
    ]
]

requirements: funct [
    {Test requirements.}
    about
    block [block!] {Series of test blocks. A textual requirement begins the block (optional).}
    /result
] [
    results: new-line/all/skip collect [
        foreach test block [
            if not block? test [
                fail [{Test must be a block. Got: } (mold test)]
            ]
            value: none
            error? set/any 'value try bind test 'throws-error
            keep all [
                value? 'value
                logic? value
                value
            ]
            keep/only either string? test/1 [test/1] [test]
        ]
    ] true 2

    remove-each [passed id] results [passed]
    all-passed?: empty? results

    if result [return all-passed?]

    either all-passed? [
        compose/only [
            (:about) passed
        ]
    ] [
        new-line compose/only [
            (:about) TODO
            (new-line/all extract next results 2 true)
        ] true
    ]
]


text:
library(tourr)
library(ggvis)
library(shiny)

aps <- 2
fps <- 30

mat <- rescale(as.matrix(flea[1:6]))
tour <- new_tour(mat, grand_tour(), NULL)
start <- tour(0)

proj_data <- reactive({
  invalidateLater(1000 / fps, NULL);
  step <- tour(aps / fps)
  data.frame(center(mat %*% step$proj), species = flea$species)
})

proj_data %>% ggvis(~X1, ~X2, fill = ~species) %>%
  layer_points() %>%
  scale_numeric("x", domain = c(-1, 1)) %>%
  scale_numeric("y", domain = c(-1, 1)) %>%
  set_options(duration = 0)

max_stars_repo_name: romainfrancois/ggvis

max_issues_repo_name: romainfrancois/ggvis

max_forks_repo_name: romainfrancois/ggvis


text:
# eFormsOrganizeData_byTable.r
# Purpose: For each type of data, organize into data frames
# First figure out the type of data by sample type
#
# Created 2/27/2019 by Karen Blocksom
###############################################################

eFormsOrganize_byTable.ncca <- function(rawData){
  # Extract visit info
  visitinfo <- as.data.frame(rawData[1:7],stringsAsFactors=F)
  # Extract sample type from 8th element in each file
  sampletype <- names(rawData)[8]

  # Create data frame of parsed data to start with, making them all character variables
  parsedData <- as.data.frame(rawData[8])
  parsedData[,names(parsedData)] <- lapply(parsedData[,names(parsedData)], as.character)

  # run parsed data through organizing function, based on sample type
  switch(sampletype,
    ASSESSMENT = {rr <- organizeAssessment.ncca(parsedData)},
    CALIBRATION = {rr <- organizeCalibration.ncca(parsedData)},
    VERIFICATION = {rr <- organizeVerification.ncca(parsedData)},
    SAMPLES = {rr <- organizeSamples.ncca(parsedData)},
    PROFILE = {rr <- organizeProfile.ncca(parsedData)},
    ECOFISH = {rr <- organizeEcofish.ncca(parsedData)},
    HHFISH = {rr <- organizeHHfish.ncca(parsedData)},
    SAMPLE_PROCESS = {rr <- organizeSampProc.ncca(parsedData)}
  )

  ss <- list(cbind(visitinfo, rr))
    # Add new object to list with sample type name
  ss[["SAMPLE_TYPE"]] <- sampletype
  return(ss)
}

#############################################################################################################
# This begins the section which organizes the parsed data by sample type

organizeVerification.ncca <- function(parsedIn){
# Simply melt these data and clean up parameter names
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'VERIF'

  varLong <- names(parsedIn)
  aa.long <- reshape(aa, idvar=c('SAMPLE_TYPE'), varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'PARAMETER', direction = 'long')
  aa.long$PARAMETER <- with(aa.long, gsub('VERIFICATION\\.', '', PARAMETER))

  aa.long$SAMPLE_TYPE <- with(aa.long, ifelse(grepl('MACRO_ALGAE|BOTTOM_TYPE|HABITAT|MACRO_ABUNDANCE|MACROALGAE|MARINE_DEBRIS|MARINE_DEBRIS_TYPE|SAV|SAV_ABUNDANCE', PARAMETER), 'SHAB', 'VERIF'))
  aa.long <- subset(aa.long, str_detect(PARAMETER, 'REVIEW')==FALSE)

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE','PARAMETER','RESULT'))

  return(aa.out)

}

organizeSamples.ncca <- function(parsedIn){
  # Simply melt these data by SAMPLE_TYPE and clean up parameter names
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'SAMPLES'

  varLong <- names(parsedIn)
  aa.long <- reshape(aa, idvar = 'SAMPLE_TYPE', varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'variable', direction = 'long')
  aa.long$SAMPLE_TYPE <- with(aa.long, substring(as.character(variable), 9, 12))
  aa.long$variable <- with(aa.long, gsub('SAMPLES\\.', '', variable))
  aa.long$PARAMETER <- with(aa.long, ifelse(str_detect(variable, '\\_COMMENT')|variable=='BENTHIC_DISTANCE',
                                      variable, substring(as.character(variable),6,nchar(as.character(variable)))))
  aa.long <- subset(aa.long, str_detect(variable, 'REVIEW')==FALSE)

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE','PARAMETER','RESULT'))

  return(aa.out)
}

organizeAssessment.ncca <- function(parsedIn){
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'ASSESS'

  aa.long <- reshape(aa, idvar = 'SAMPLE_TYPE', varying = names(parsedIn),
                     times = names(parsedIn), v.names = 'RESULT', timevar = 'PARAMETER',
                     direction = 'long')

  aa.long$PARAMETER <- with(aa.long, gsub("ASSESSMENT\\.", "", PARAMETER))
  aa.long <- subset(aa.long, str_detect(PARAMETER, 'REVIEW')==FALSE)

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE','PARAMETER','RESULT'))

  return(aa.out)

}

organizeProfile.ncca <- function(parsedIn){
 # NEED TO FIND PARAMETERS THAT START WITH CHARACTER VS. NUMBER
  aa <- subset(parsedIn, select=str_starts(names(parsedIn),'PROFILE\\.[:alpha:]'))
  aa$SAMPLE_TYPE <- 'HYDRO'
  aa$LINE <- '0'

  varLong <- names(aa)[!(names(aa) %in% c('SAMPLE_TYPE','LINE'))]
  aa.long <- reshape(aa, idvar = c('SAMPLE_TYPE','LINE'), varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'PARAMETER', direction = 'long')
  aa.long$PARAMETER <- with(aa.long, str_replace(PARAMETER, "PROFILE\\.",""))
  aa.long$SAMPLE_TYPE <- with(aa.long, ifelse(str_starts(PARAMETER,'CLEAR_TO_BOTTOM|DISAPPEARS|REAPPEARS|SECCHI'),'SECC', SAMPLE_TYPE))
  aa.long <- subset(aa.long, str_detect(PARAMETER, 'REVIEW')==FALSE)

  aa.out <- subset(aa.long, select = c('SAMPLE_TYPE','LINE','PARAMETER','RESULT'))

# bb pulls out and formats species by line number and sample type
  bb <- subset(parsedIn, select=str_starts(names(parsedIn), 'PROFILE\\.[:digit:]'))
  bb$SAMPLE_TYPE <- 'HYDRO'

  varLong <- names(bb)[names(bb)!='SAMPLE_TYPE']
  bb.long <- reshape(bb, idvar='SAMPLE_TYPE', varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'variable', direction = 'long')
  bb.long$variable <- with(bb.long, gsub('PROFILE\\.', '', variable))
  bb.long$LINE <- str_extract(bb.long$variable, '[:digit:]+')
  bb.long$PARAMETER <- str_replace(bb.long$variable, '[:digit:]+\\_', '')
  bb.long <- subset(bb.long, str_detect(variable, 'REVIEW')==FALSE)

  bb.out <- base::subset(bb.long, select=c('SAMPLE_TYPE','LINE','PARAMETER','RESULT'))

  cc <- rbind(aa.out, bb.out)

  return(cc)

}

organizeCalibration.ncca <- function(parsedIn){
  # Simply melt data and clean up parameter names
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'CALIB'

  varLong <- names(aa)[names(aa)!='SAMPLE_TYPE']
  aa.long <- reshape(aa, idvar = 'SAMPLE_TYPE', varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'PARAMETER', direction = 'long')

  aa.long$PARAMETER <- gsub('CALIBRATION\\.', '', aa.long$PARAMETER)
  aa.long <- subset(aa.long, str_detect(PARAMETER, 'REVIEW')==FALSE)

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE','PARAMETER','RESULT'))

  return(aa.out)

}

organizeEcofish.ncca <- function(parsedIn){
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'EINF'

  varLong <- names(aa)[names(aa)!='SAMPLE_TYPE']
  aa.long <- reshape(aa, idvar = 'SAMPLE_TYPE', varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'PARAMETER', direction = 'long')
  aa.long$SAMPLE_TYPE <- substring(aa.long$PARAMETER, 9, 12)
  aa.long <- subset(aa.long, str_detect(PARAMETER, 'REVIEW')==FALSE)
  aa.long$PARAMETER <- with(aa.long, substring(PARAMETER, 14, nchar(PARAMETER)))

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE', 'PARAMETER', 'RESULT'))

  return(aa.out)
}

organizeHHfish.ncca <- function(parsedIn){
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'HINF'

  varLong <- names(aa)[names(aa)!='SAMPLE_TYPE']
  aa.long <- reshape(aa, idvar = 'SAMPLE_TYPE', varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'PARAMETER', direction = 'long')

  aa.long$SAMPLE_TYPE <- substring(aa.long$PARAMETER, 8, 11)
  aa.long <- subset(aa.long, str_detect(PARAMETER, 'REVIEW')==FALSE)
  aa.long$PARAMETER <- with(aa.long, substring(PARAMETER, 13, nchar(PARAMETER)))

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE', 'PARAMETER', 'RESULT'))

  return(aa.out)

}

organizeSampProc.ncca <- function(parsedIn){

  # Simply melt these data by SAMPLE_TYPE and clean up parameter names
  aa <- parsedIn
  aa$SAMPLE_TYPE <- 'SAMPLES'

  varLong <- names(parsedIn)
  aa.long <- reshape(aa, idvar = 'SAMPLE_TYPE', varying = varLong, times = varLong,
                     v.names = 'RESULT', timevar = 'variable', direction = 'long')
  aa.long$variable <- with(aa.long, gsub('SAMPLE\\_PROCESS\\.', '', variable))
  aa.long$SAMPLE_TYPE <- with(aa.long, substring(as.character(variable), 1, 4))
  aa.long <- subset(aa.long, str_detect(variable, 'REVIEW')==FALSE)
  aa.long$PARAMETER <- ifelse(aa.long$variable=='BENTHIC_DISTANCE', aa.long$variable,
                              substring(aa.long$variable, 6, nchar(aa.long$variable)))

  aa.out <- base::subset(aa.long, select = c('SAMPLE_TYPE','PARAMETER','RESULT'))

  return(aa.out)

}