text:
.setUp <- function() {}
.tearDown <- function() {}

test.tojson <- function()
{
	x <- 15433
	j <- toJSON( x, "C" )
	checkIdentical( j, "15433" )

	x <- 15.543
	j <- toJSON( x, "C" )
	checkIdentical( j, "15.543" )

	x <- TRUE
	j <- toJSON( x, "C" )
	checkIdentical( j, "true" )

	x <- FALSE
	j <- toJSON( x, "C" )
	checkIdentical( j, "false" )

	x <- NULL
	j <- toJSON( x, "C" )
	checkIdentical( j, "null" )

	#Test strings
	x <- "hello"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"hello\"" )

	x <- "hel\"lo"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"hel\\\"lo\"" )

	x <- "hel\n"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"hel\\n\"" )

	x <- "\n\r\t"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"\\n\\r\\t\"" )

	x <- ""
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"\"" )

	x <- "\u0041\u006c\u0065\u0078\u002B"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"Alex+\"" )

	x <- "\u018E"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"\\u018e\"" )

	x <- "\u3020"
	j <- toJSON( x, "C" )
	checkIdentical( j, "\"\\u3020\"" )

	#test arrays
	x <- c(10, 50, 30)
	j <- toJSON( x, "C" )
	checkIdentical( j, "[10,50,30]" )

	x <- list(10, 50, 30)
	j <- toJSON( x, "C" )
	checkIdentical( j, "[10,50,30]" )

	x <- list(10, 50, TRUE)
	j <- toJSON( x, "C" )
	checkIdentical( j, "[10,50,true]" )

	x <- list(10, 50, list())
	j <- toJSON( x, "C" )
	checkIdentical( j, "[10,50,[]]" )

	x <- list(10, 50, NULL)
	j <- toJSON( x, "C" )
	checkIdentical( j, "[10,50,null]" )

	x <- list()
	j <- toJSON( x, "C" )
	checkIdentical( j, "[]" )

	x <- c(T,T,F,F,T,F)
	j <- toJSON( x, "C" )
	checkIdentical( j, "[true,true,false,false,true,false]" )

	#test dicts
	x <- list(key="value")
	j <- toJSON( x, "C" )
	checkIdentical( j, "{\"key\":\"value\"}" )

	x <- c(key="value")
	j <- toJSON( x, "C" )
	checkIdentical( j, "{\"key\":\"value\"}" )

	x <- c(key=TRUE, car=FALSE)
	j <- toJSON( x, "C" )
	checkIdentical( j, "{\"key\":true,\"car\":false}" )

	x <- list(key=TRUE, car=FALSE, apple=c(10.5, 28))
	j <- toJSON( x, "C" )
	checkIdentical( j, "{\"key\":true,\"car\":false,\"apple\":[10.5,28]}" )

	x <- c(a=T,b=F)
	j <- toJSON( x, "C" )
	checkIdentical( j, "{\"a\":true,\"b\":false}" )

}


text:
# load libraries
library(dplyr); library(foreach); library(bspec); library(reticulate); library(signal)

# define function to pre-process data
score <- function(s_file, s_c3a2, s_loc, s_roc, s_emg, i) {
  i(10, text = sprintf("%s%%", 10))
  # load header
  rec_header <- edfReader::readEdfHeader(s_file)

  # change epoch length (in seconds) if necessary
  epochl <- 20
  # change sliding windows length used for computing power spectra
  windowl <- 5

  # sampling rate for main derivation
  fs <- rec_header$sHeaders$sRate[rec_header$sHeaders$label==s_c3a2]
  # downsampling to 128 Hz. dn is downsampling factor
  dn <- fs %/% 128

  i(20, text = sprintf("%s%%", 20))
  # read corresponding EDF file
  eeg_recording <- rec_header %>% edfReader::readEdfSignals()

  i(30, text = sprintf("%s%%", 30))
  # Downsampling to frequency close to 128Hz
  eeg_downsampled <- foreach(c=c(s_c3a2, s_loc, s_roc, s_emg), .combine=cbind) %do% decimate(eeg_recording[[c]][['signal']], dn) %>%
    as_tibble() %>% rename_all(~c(s_c3a2, s_loc, s_roc, s_emg)) %>% mutate_all(round,3)
  #-------------------------------------------------------------------------------------------------------------
  # notch filter function
  notch_f <-  function(x) {
    notch_buttf <- signal::butter(2, W=c(49/64, 51/64), type="stop") # filtering out 50HZ signal with a stopband butterworth filter first order
    signal::filter(notch_buttf, x)
  }
  # high pass filter function
  # high_passf <-  function(x) {
  #   high_buttf <- signal::butter(1, W=2/64, type="high") # filtering out 50HZ signal with a stopband butterworth filter first order. Check filter with freqz(buttf)
  #   signal::filter(high_buttf, x)
  # }
  # welch power spectral density function using hanning sliding window (length set by windowl)
  pwelch_spectra <- function(c3a2_signal, window_length, downsampled_frequency) {
    t_welch <- welchPSD(ts(c3a2_signal, frequency = downsampled_frequency), windowfun = hannwindow, seglength = window_length)
    t_welch$power
  }
  #-------------------------------------------------------------------------------------------------------------
  i(40, text = sprintf("%s%%", 40))
  # apply filters
  eeg_downsampled_filtered <- eeg_downsampled %>% # choose and apply filters
    mutate(across(everything(), notch_f)) # %>% mutate(across(C3_A2:C4_A1, high_passf))

  # computing numbers of epochs
  n_epochs <- floor((nrow(eeg_downsampled_filtered) / (fs/dn)) / epochl)

  eeg_nested <- eeg_downsampled_filtered[1:(n_epochs*epochl*(fs/dn)),] %>%
    mutate(epoch = rep(1:n_epochs, each = (fs/dn) * epochl)) %>%
    tidyr::nest(data = -epoch) %>%
    mutate(epoch = glue::glue('epoch_{epoch}')) %>%
    tidyr::unnest_wider(data)

  # extracting C3:A2 signal to compute spectra
  c3_a2_wider <- eeg_nested %>%
    dplyr::select(epoch, all_of(s_c3a2)) %>%
    tidyr::pivot_wider(names_from = epoch, values_from = all_of(s_c3a2)) %>%
    summarize(across(starts_with('epoch'), unlist))

  i(50, text = sprintf("%s%%", 50))

  # add frequency column
  t_fs <- welchPSD(ts(c3_a2_wider$epoch_1, frequency = (fs/dn)), windowfun = hannwindow, seglength = windowl)

  # computing spectra in parallel
  c3_a2_spectra_wider <- c3_a2_wider %>%
    summarize(across(starts_with('epoch'), ~pwelch_spectra(., windowl, (fs/dn)))) %>% bind_cols('freq'=t_fs$frequency)
  c3_a2_spectra <- c3_a2_spectra_wider %>%
    tidyr::pivot_longer(!freq, names_to='epoch', values_to = 'power') %>%
    mutate(epoch = readr::parse_number(epoch))

  i(60, text = sprintf("%s%%", 60))

  #  compute PEMG
  emg_wider <- eeg_nested %>%
    dplyr::select(epoch, all_of(s_emg)) %>%
    tidyr::pivot_wider(names_from = epoch, values_from = all_of(s_emg)) %>%
    summarize(across(starts_with('epoch'), unlist))

  i(70, text = sprintf("%s%%", 70))
  emg_spectra <- emg_wider %>% summarize(across(starts_with('epoch'), ~pwelch_spectra(., windowl, (fs/dn)))) %>% bind_cols('freq'=t_fs$frequency) %>%
    tidyr::pivot_longer(!freq, names_to='epoch', values_to = 'power') %>%
    mutate(epoch = readr::parse_number(epoch))

  PEMG <- emg_spectra %>% dplyr::filter(freq>15, freq<30) %>% dplyr::select(-freq) %>%
    group_by(epoch) %>%
    mutate(power = log(power+1), power = power-quantile(power, probs = 0.1),
           power = runmed(power, 5), power = power/mean(power[1:10]), power = if_else(power>1, 1, power),
           power = if_else(power < -1, -1, power), power = power/max(power)) %>%
    ungroup() %>%
    group_by(epoch) %>%
    summarize(pemg = mean(power))
  i(80, text = sprintf("%s%%", 80))
  #-------------------------------------------------------------------------------------------------------------
  # save as matfile
  R.matlab::writeMat(paste0(substr(s_file, 0, nchar(s_file)-4), '1.mat'),
                     Data = list(windowl=windowl,
                                 stages = t(rep(0, ncol(c3_a2_wider))),
                                 channel.names = rec_header$sHeaders$label,
                                 fs = (fs/dn),
                                 epochl = epochl,
                                 C3A2 = c3_a2_wider %>% data.matrix(),
                                 Pspec = c3_a2_spectra_wider %>% dplyr::select(-freq) %>% data.matrix(),
                                 PEMG = PEMG$pemg,
                                 # Left ocular signal
                                 LOC = eeg_nested %>% dplyr::select(epoch, all_of(s_loc)) %>%
                                   tidyr::pivot_wider(names_from = epoch, values_from = all_of(s_loc)) %>%
                                   summarize(across(starts_with('epoch'), unlist)) %>%
                                   data.matrix(),
                                 # Right ocular signal
                                 ROC =  eeg_nested %>% dplyr::select(epoch, all_of(s_roc)) %>%
                                   tidyr::pivot_wider(names_from = epoch, values_from = all_of(s_roc)) %>%
                                   summarize(across(starts_with('epoch'), unlist)) %>%
                                   data.matrix(),
                                 # electromyogram signal
                                 EMG = emg_wider %>% data.matrix(),
                                 max.sample = nrow(eeg_downsampled_filtered),
                                 maxep = n_epochs
                     )
  )
  i(90, text = sprintf("%s%%", 90))
  #-------------------------------------------------------------------------------------------------------------
  # copy mat file to sleep-scoring mat folder and execute python script
  file.copy(paste0(substr(s_file, 0, nchar(s_file)-4), '1.mat'), '../mat/', overwrite = TRUE )
  # load reticulate and exectute scoring python script
  reticulate::py_config()
  reticulate::py_run_file("predict.py")
  i(100, text = sprintf("%s%%", 100))
}

ext: r


text:
#' #This source code is provided under the BSD license and is provided AS IS with no warranty or guarantee of fit for purpose.  See the project's LICENSE.txt for details.
#' #Copyright Thomson Reuters 2013. All rights reserved.
#' @export example.connection
#' @author Sameena Shah
#' @param server server address
#' @param uid userid
#' @param pwd password
#' @param other any other information like database name etc, none by default
#' @return returns an odbcConnection object
#' @import RODBC
example.connection <- function(server,uid,pwd,other="")
{
  str <- sprintf("DRIVER={SQL SERVER};SERVER=%s;uid=%s;pwd=%s;%s",server,uid,pwd,other)
  str
  return(odbcDriverConnect(str))
}

max_stars_repo_name: thomsonreuters/oqad

max_issues_repo_name: GregLee-TR/oqad

max_forks_repo_name: thomsonreuters/oqad


text:
## Run this script with:
## R CMD BATCH install-packages.r

## Create the personal library if it doesn't exist.
## Ignore a warning if the directory already exists.
dir.create(Sys.getenv("R_LIBS_USER"), showWarnings=FALSE, recursive=TRUE)

## Install jsonlite and optparse packages
install.packages(c("jsonlite", "optparse", "getopt"), Sys.getenv("R_LIBS_USER"), repos="http://cran.case.edu")

max_stars_repo_name: felipecustodio/ai

max_issues_repo_name: felipecustodio/ai

max_forks_repo_name: felipecustodio/ai


text:
x<-c(0.5, 1, 1.5, 2, 2.5, 3)

y6<-c(3.4, 6.3, 12, 21, 29, 44)
y5<-c(3.9, 7.2, 14, 22, 36, 57)
y4<-c(3.9, 7.9, 16, 25, 40, 66)

y4_2<-c(4.3, 9.2, 17, 22, 40, 51)
y5_2<-c(4, 7.8, 14, 20, 30, 41)
y6_2<-c(3.7, 6.5, 13, 18, 25, 33)

chart.cex<-1.5
lwd.2<-2
col.4.1<-"#B0B0B0"
col.5.1<-"#FFD5B0"
col.6.1<-"#D0D0FF"
col.4.2<-"black"
col.5.2<-"orange"
col.6.2<-"blue"
pch.4<-17
pch.5<-15
pch.6<-19

plot (x, y4, pch=pch.4, cex=chart.cex, col=col.4.1, xlab="Data set size, millions of records", ylab="Time taken, minutes")
lines (x, y4, col=col.4.1)

points(x, y5, col=col.5.1, pch=pch.5, cex=chart.cex)
lines (x, y5, col=col.5.1)

points(x, y6, col=col.6.1, pch=pch.6, cex=chart.cex)
lines(x,y6, col=col.6.1)

points(x, y4_2, col=col.4.2, pch=pch.4, cex=chart.cex)
lines(x,y4_2, col=col.4.2, lwd=lwd.2)

points(x, y5_2, col=col.5.2, pch=pch.5, cex=chart.cex)
lines (x, y5_2, col=col.5.2, lwd=lwd.2)

points(x, y6_2, col=col.6.2, pch=pch.6, cex=chart.cex)
lines (x, y6_2, col=col.6.2, lwd=lwd.2)

legend ("topleft",
        legend=c("Version 0.0.1 on 4 worker nodes", "0.0.1 on 5 nodes", "0.0.1 on 6 nodes", "Version 0.0.2 on 4 worker nodes", "0.0.2 on 5 nodes", "0.0.2 on 6 nodes"),
        col=c(col.4.1, col.5.1, col.6.1, col.4.2, col.5.2, col.6.2), pch=c(pch.4, pch.5, pch.6, pch.4, pch.5, pch.6))


text:
.NH "Xware 4:  Utilities"
.PP
Congratulations on purchasing Xware 4.
This package contains a selection of X utilities.
We believe that you will find most of them to be fun to work with, and
all of them useful.
.PP
This package also holds the library
.BR libXpm.a ,
whose functions manipulate pix-mapped images;
and a manual page for every program.
.SH "What is Xware?"
Xware is a series of packages from Mark Williams Company
that bundle some of the most popular and useful software
for the X Window System.
Each program in a Xware package comes with an executable binary;
source code;
instructions and scripts to help you recompile and install the program;
and a manual page for the program edited and formatted in the \*(CO
Lexicon format, which you can view with the \*(CO command
.BR man .
.PP
Other Xware packages are available or are being prepared.
These include packages of X window managers, games, graphics,
and development tools.
Xware makes it easy and convenient for you
to enlarge your supply of X software.
.SH "System Resources"
.PP
All of the programs in this package run in eight megabytes of RAM.
.PP
The amount of disk space depends upon how many programs you install,
and whether you leave the sources archives on your system or delete them.
As a rule of thumb,
you should assume that each de-archived program and its sources
consume between one-half and one megabyte of disk space.
Directions on how to install a program are given below.
.PP
The size of the screen required varies from program to program.
A few will run on a 640\(mu480 screen; most fit into 800\(mu600;
a few require a 1024\(mu768 screen.
Those that use the 1024\(mu768 screen can, in most instances,
be run under 800\(mu600, although the image being displayed may be cropped.
If you are using a virtual window manager (e.g.,
.B fvwm
or
.BR olwm ,
both of which are included with Xware volume 1),
you can cope by sliding the screen window around; patience is recommended.
.PP
Most programs recompile correctly with the \*(CO C compiler.
A few must be recompiled with the GCC compiler, which is
not included with this package.
Each archive contains a file named
.BR README.Coh ,
which describes how to install and recompile it; and each contains a
script called
.B Install.Coh
which installs the executable and its ancillary files (if any)
onto your system.
.PP
By default,
some of the utilities in this package use fonts that are included with the
Xware 1 window-managers package.
If you do not have this package, you can either revise the resource files
for these applications so that they use fonts that are included with X
Windows for \*(CO, or you can obtain the fonts from the Mark Williams
Bulletin Board.
.SH "Contents of This Package"
.PP
The individual programs are kept in the form of compressed archives.
When you install this package onto your system, all of the archives are
copied into directory
.BR /usr/X11/utilities ,
and the manual pages are installed into directory
.BR /usr/man/Xware4 .
.PP
The following describes the contents of this package:
.IP \fBgremlin\fR
A tool for drawing pictures and diagrams.
.IP \fBnotes\fR
Write, edit, and review notes to yourself.
Notes can be ``pasted'' to the screen as reminders.
.IP \fBsunclock\fR
Display the solar time around the globe.
This utility features excellent graphics.
.IP \fBtransfig\fR
Transform graphics files created with
.B xfig
into a variety of formats, including PostScript and TeX.
.IP \fBxabacus\fR
Display a standard Chinese abacus,
on which you can count and perform
arithmetic.
This utility also comes with a series of interactive tutorials to teach
you how to use the oldest computer of them all.
.IP \fBxcalendar\fR
Display a monthly calendar.
You can write reminders and notes for each day of the month.
.IP \fBxcuckoo\fR
This program lays its ``egg'' in the title bar of a window that is owned
by another program.
It's not exactly a utility, but it does demonstrate how to program
interprocess communication under X.
.IP \fBxdu\fR
This program reads the output of the \*(CO command
.BR du ,
and translates it into a histogram that shows graphically how much disk
space directories are consuming.
.IP \fBxfig\fR
This paint program lets you draw and paint pictures interactively.
With its companion program
.BR transfig ,
you can write
.BR xfig 's
the output into a variety of formats, including PostScript and TeX.
.IP \fBxfilemgr\fR
Manipulate files interactively, using a point-and-click environment.
The graphics are impressive.
.IP \fBxman\fR
Display manual pages interactively, by pointing and clicking.
.IP \fBxmore\fR
This resembles the \*(CO command
.BR more ,
which displays text files;
except that it uses a graphical X interface and has more features.
.IP \fBxpostit\fR
Create an electronic version of the popular
``Post-it'' notes.
With this program, you can create notes,
``stick'' them onto your root window, save them, and redisplay them.
The notes come in standard sizes and ``designer colors''.
.IP \fBxpt\fR
This program displays the periodic table of the elements.
Clicking on one cell of the table displays detailed
information about that element.
.IP \fBxspread\fR
A spreadsheet program that resembles some popular commercial packages.
Included are tools to perform matrix arithmetic and graphing.
.SH "Installing This Package"
.PP
To install this package onto your system, log in as the superuser
.B root
and type the installation command:
either
.DM
	/etc/install Xware4 /dev/fva0 4
.DE
if you have a 3.5-inch floppy-disk drive, or
.DM
	/etc/install Xware4 /dev/fha0 5
.DE
if your floppy-disk drive is 5.25 inches.
.B install
copies the programs into directory
.BR /usr/X11/utilities ,
installs the few extra tools you need to recompile these programs,
and automatically installs the manual pages for the programs.
.SH "Installing an Individual Program"
.PP
As described above, each program is kept in a compressed archive in directory
.BR /usr/X11/utilities .
Each archive contains a compiled version of the program, ready for running;
the sources for the program;
a file called
.BR README.Coh ,
which describes how to recompile the program, should you wish;
and a script named
.BR Install.Coh ,
which installs the program for you.
To install a program so you can use it, do the following:
.IP \(bu 0.3i
.B cd
to directory
.BR /usr/X11/utilities .
.IP \(bu
Use the command
.B gtar
to de-archive and uncompress the archive that holds the program you want.
For example, if you want to install program
.BR xfig ,
type the command:
.DM
	gtar -xvzf xfig.gtz
.DE
.IP \(bu
Change to the directory that holds the newly de-archived program.
For example, when you un-tar archive
.BR xfig.gtz ,
the program and its source files are copied into directory
.BR xfig .
.IP \(bu
Use the command
.B su
to become the superuser
.BR root ,
and execute script
.BR Install.Coh .
Each program has such a script; it handles all the details of
installation for you.
.IP \(bu
After you have installed the program, you may wish to remove the source
code and other files that you do not need.
To do so,
.B cd
back to the program's parent directory, and use the command
.B "rm \-rf"
to remove the directory and its contents.
For example, after you have installed
.BR xfig ,
you can remove this directory by typing the following commands:
.DM
	cd ..
	rm -rf xfig
.DE
Note that the archive from which you copied the program,
.BR xfig.gtz ,
is untouched by removing the directory
.BR xfig .
You can always de-archive the program again should you wish to work with
its program files or re-install it.
.PP
If you wish to recompile a program, follow the directions given in file
.B README.Coh
in that program's source directory.
.SH Recompiling
.PP
The file
.B README.Coh
in each package describes how to recompile it.
Before you can recompile some programs, you must first install the
X update kit.
This kit contains updated versions of some X header files, of the utility
.BR make ,
and of the \*(CO C compiler, as well as modified versions of other files.
This kit is available for free from the MWC BBS, or from the
.B ftp
site
.BR raven.alaska.edu .
If you cannot contact either site, write to MWC Technical Support as described
below, and a copy will be sent to you.
.SH "Modifying Resource Files"
The resource files that are installed by default with these applications
work nicely on a color monitor.
Most also work with a monochrome display; however, in some instances you
may wish to modify them.
.PP
Consider, for example, the following entries from the resource file
.BR /usr/X11/lib/app-defaults/XPostit ,
which is used by the program
.BR xpostit .
It contains the following entries that set colors:
.DM
.ta 0.5i 2.5i
	XPostit*Background:	PeachPuff
	XPostit*Foreground:	NavyBlue
	XPostit*Text*Background:	Yellow
	XPostit*Text*Foreground:	Black
	XPostit*Plaid*Background:	Red
	XPostit*Plaid*Foreground:	Black
.DE
.PP
A monochrome server maps both red and black (the colors used by the
.B Plaid
resource) to black; therefore, instead of seeing a cheerful plaid, you will
just see a black rectangle.
To fix this problem, edit the lines to read as follows:
.DM
.ta 0.5i 2.5i
	XPostit*Background:	PeachPuff
	XPostit*Foreground:	NavyBlue
	XPostit*Text*Background:	Yellow
	XPostit*Text*Foreground:	Black
	XPostit*Plaid*Background:	White
	XPostit*Plaid*Foreground:	Black
.DE
.PP
It's not always easy to predict which colors will be mapped to black and
which to white; you may have to depend upon trial and error.
.SH "Copyrights"
.PP
Please note that the software in this package comes from third-party sources.
It is offered ``as is'', with no guarantee or warranty stated or implied,
whatsoever.
The copyrights on the source code and any executables built from it
belong to the persons who wrote the original code; full copyright
statements are included with the source code to each program.
We ask that you read and respect these statements.
.SH "Technical Support"
.PP
The sources in this package have been compiled and run successfully under
\*(CO.
If you have a problem bringing up one of the programs or with
compiling the source code as it is configured in this package, our
technical support team will attempt to help you.
However, because of the highly technical nature of the source
code in these packages, Mark Williams Company
.I cannot
give you technical assistance should you modify any of the source code
included in this package in any manner whatsoever.
.SH "A Final Word"
.PP
Most of the source code for these programs, and for the program shipped in
our other Xware packages,
is available for free on the Mark Williams bulletin board system.
The tutorial for
.B UUCP
in the \*(CO manual describes how to contact the BBS and make its services
available to you.
.PP
We hope that you enjoy using these programs!

max_stars_repo_name: gspu/Coherent

max_issues_repo_name: gspu/Coherent

max_forks_repo_name: gspu/Coherent


text:
library("testthat")
library("waddR")

##########################################################################
##                    WASSERSTEIN METRIC CALCULATION                    ##
##########################################################################

# R implementation to test against, from the package transport
wasserstein1d <- function (a, b, p = 1, wa = NULL, wb = NULL) {
  m <- length(a)
  n <- length(b)
  stopifnot(m > 0 && n > 0)
  if (m == n && is.null(wa) && is.null(wb)) {
    return( mean( abs( sort(b) - sort(a) )^p )^(1/p))
  }
  if (is.null(wa)) {
    wa <- rep(1, m)
  }
  if (is.null(wb)) {
    wb <- rep(1, n)
  }
  stopifnot(length(wa) == m && length(wb) == n)

  # normalizes values to sum up to 1
  ua <- (wa/sum(wa))[-m]
  ub <- (wb/sum(wb))[-n]

  cua <- c(cumsum(ua))
  cub <- c(cumsum(ub))
  temp <- cut(cub, breaks = c(-Inf, cua, Inf))
  arep <- table(temp) + 1
  temp <- cut(cua, breaks = c(-Inf, cub, Inf))
  brep <- table(temp) + 1

  # repeat each element in a and b as often as the intervals in arep and brep
  # are mentionned
  aa <- rep(sort(a), times = arep)
  bb <- rep(sort(b), times = brep)

  # combine ecdf of weights vectors for a and b
  uu <- sort(c(cua, cub))

  ## Quantiles of empirical Fa and Fb
  uu0 <- c(0, uu)
  uu1 <- c(uu, 1)
  areap <- sum((uu1 - uu0) * abs(bb - aa)^p)^(1/p)

  return(areap)
}

##################################################
#   WASSERSTEIN IMPLEMENTATION (Approximation)   #
##################################################

# test correctness of wasserstein approximation
test_that("squared_wass_approx correctness", {

  a <- c(13, 21, 34, 23)
  b <- c(1,  1,  1,  2.3)
  # case with equally long vectors a and b
  expect_known("value", squared_wass_approx(a,b),
               file="known.values/testresult_squared_wass_approx_correctness1")
  set.seed(42)
  a2 <- rnorm(100, 10, 1)
  set.seed(24)
  b2 <- rnorm(102, 10.5, 1)
  expect_known("value", squared_wass_approx(a2,b2),
               file="known.values/testresult_squared_wass_approx_correctness3")
})

##################################################
#   WASSERSTEIN DECOMPOSITION (Approximation)    #
##################################################

# test correctnes of decomposed wasserstein approximation
test_that("squared_wass_decomp correctness", {
  a <- c(13, 21, 34, 23)
  b <- c(1,  1,  1,  2.3)

  # case with equally long vectors a and b
  res <- squared_wass_decomp(a,b)
  location <- (mean(a) - mean(b))**2
  expect_equal(res$location, location)
  size <- (sd(a) - sd(b))**2
  expect_equal(res$size, size)
  a.quant <- quantile(a, probs=(seq(1000)-0.5)/1000, type=1)
  b.quant <- quantile(b, probs=(seq(1000)-0.5)/1000, type=1)
  shape <- (2 * sd(a) * sd(b) * (1 - cor(a.quant, b.quant)))
  expect_equal(res$shape, shape)
  expect_equal(res$distance, location + size + shape)

  # test for special case that caused the shape calculation to fail
  x <- rep(0,107)
  y <- c(rep(0,154), 0.8463086, rep(0, 26))
  res <- squared_wass_decomp(x, y)
  location <- (mean(x) - mean(y))**2
  expect_equal(res$location, location)
  size <- (sd(x) - sd(y))**2
  expect_equal(res$size, size)
  x.quant <- quantile(x, probs=(seq(1000)-0.5)/1000, type=1)
  y.quant <- quantile(y, probs=(seq(1000)-0.5)/1000, type=1)
  # shape is zero, because sd(x) == 0
  shape <- 0
  expect_equal(res$shape, shape)
  expect_equal(res$distance, location + size + shape)
})

##################################################
#       WASSERSTEIN_METRIC IMPLEMENTATION        #
##################################################

# test correctnes of wasserstein_metric versus an R implementation
test_that("wasserstein_metric correctness", {
  a <- c(13, 21, 34, 23)
  b <- c(1,  1,  1,  2.3)
  p <- 2
  # case with equally long vectors a and b
  expect_equal(wasserstein_metric(a,b,p), wasserstein1d(a,b,p))
  expect_equal(wasserstein_metric(a,b), wasserstein1d(a,b))

  # vectors of different lengths
  x <- c(34, 4343, 3090, 1309, 23.2)
  set.seed(42)
  a2 <- rnorm(100,10,1)
  set.seed(24)
  b2 <- rnorm(102,10.5, 1)
  expect_equal(wasserstein_metric(a2,b2,p), wasserstein1d(a2,b2,p))
  expect_equal(wasserstein_metric(a,x,p), wasserstein1d(a,x,p))

  # Bug when length(a) == 1 and legth(b) > 2
  a3 <- c(23)
  b3 <- c(0,1,0,0)
  expect_equal(wasserstein_metric(a3, b3, p), wasserstein1d(a3,b3,p))

  # a simulated permutation procedure as used in the wasserstein.test method
  set.seed(24)
  ctrl <- rnorm(300 ,0 ,1)
  set.seed(24)
  dd1 <- rnorm(300, 1, 1)
  z <- c(ctrl,dd1)
  shuffle <- permutations(z, num_permutations=1000)
  wass_metric.values <- apply(  shuffle, 2,
                                function (k) {
                                    w <- wasserstein_metric(
                                        k[seq_len(length(x))],
                                        k[seq((length(x)+1):length(z))],
                                        p=2) **2
                                    return(w)})
  wass1d.values <- apply(  shuffle, 2,
                           function (k) {
                               w <- wasserstein1d(
                                   k[seq_len(length(x))],
                                   k[seq((length(x)+1):length(z))],
                                   p=2) **2
                               return(w)})
  expect_equal(wass_metric.values, wass1d.values)
})

# test consistency of results
test_that("wasserstein_metric consistency test", {
  x <- c(2, 1, 3)
  y <- c(3, 3, 2, 6)
  results <- sapply(1:10000, function(i) { wasserstein_metric(x, y, p=2)})
  first = results[1]
  expect_true(all(results == first))
} )

max_stars_repo_name: goncalves-lab/de-detectR

max_issues_repo_name: goncalves-lab/de-detectR

max_forks_repo_name: goncalves-lab/de-detectR


text:
pdf_file<-"pdf/radial_polygons_overlay.pdf"
cairo_pdf(bg="grey98", pdf_file,width=10,height=10)

par(omi=c(1,0.25,1,1),mai=c(0,2,0,0.5),cex.axis=1.5,cex.lab=1,xpd=T,family="Lato Light",las=1)
library(plotrix)

# Import data and prepare chart

myRegions<-read.xls("myData/worldenergymix.xlsx", encoding="latin1")
myC1<-rgb(80,80,80,155,maxColorValue=255)
myC2<-rgb(255,97,0,155,maxColorValue=255)
myRegions$Region<-NULL
myLabelling<-c("Oil","Coal","Gas","Renewable Energies","Nuclear\nenergy")

# Create chart

radial.plot(myRegions[2:3,],start=1,grid.left=T,labels=myLabelling,rp.type="p",main="",line.col=c(myC1,myC2),poly.col=c(myC1,myC2),show.grid=T,radial.lim=c(0,55),lwd=8)
legend("bottomleft",c("OECD","Asia"),pch=15,col=c(myC1,myC2),bty="n",cex=1.5)

# Titling

mtext(line=3,"Energy mix: OECD and Asia by comparison",cex=2.5,adj=0,family="Lato Black")
mtext(line=1,"All values in percent",cex=1.5,adj=0,font=3)
mtext(side=1,line=2,"Source: German Federal Agency for Civic Education: keyword 'Enegiemix' [energy mix], www.bpb.de [website in German]",cex=1.05,adj=1,font=3,outer=T)
dev.off()

max_stars_repo_name: wilsonify/data-visualization

max_issues_repo_name: wilsonify/data-visualization

max_forks_repo_name: wilsonify/data-visualization


text:
  histograms.size.maturity.update = function( outdir, redo.data=F ) {
    # size frequency distributions of snow crab, broken down by maturity

      loc = file.path(project.datadirectory("bio.snowcrab"), "output", "size.data")

      dir.create(path=outdir, recursive=T, showWarnings=F)
      dir.create(path=loc, recursive=T, showWarnings=F)
      outfilename = paste( c("mi", "mm", "fi", "fm"), "rdata", sep=".")
      outfile = file.path(loc, paste(outfilename))

      # areas = c("cfanorth.not.glace.bay", "cfa22outer", "cfasouth" )
      # areas = c("cfaall",  "cfanorth", "cfasouth", "cfa20", "cfa21", "cfa22", "cfa23", "cfa24", "cfa4x", "cfa23slope", "cfa24slope", "cfaslope"  )
      areas = c("cfanorth", "cfasouth", "cfa4x")
      year = 1998:p$year.assessment
    if(length(year)>10) year = (p$year.assessment-9):p$year.assessment

      if (redo.data) {

        set = snowcrab.db( DS="set.clean")
        set$sid = paste(set$trip, set$set, sep="~")

        det = snowcrab.db( DS="det.initial")
        det$sid = paste(det$trip, det$set, sep="~")

        hvar="cw"
        bw = 2
        s0 = 10
        s1 = 150

        det=det[(det[,hvar]>=s0 & det[,hvar]<=s1),]
        breaks = seq(s0, s1, bw)

        bwf = 2
        breaksf = seq(s0, s1, bwf)

        m.imm = make.histograms(set, det[filter.class(det, "m.imm"),], hvar=hvar, breaks=breaks )
        m.mat = make.histograms(set, det[filter.class(det, "m.mat"),], hvar=hvar, breaks=breaks )
        f.imm = make.histograms(set, det[filter.class(det, "f.imm"),], hvar=hvar, breaks=breaksf )
        f.mat = make.histograms(set, det[filter.class(det, "f.mat"),], hvar=hvar, breaks=breaksf )

        save(m.imm, file=outfile[1], compress=T)
        save(m.mat, file=outfile[2], compress=T)
        save(f.imm, file=outfile[3], compress=T)
        save(f.mat, file=outfile[4], compress=T)

      }

      set = snowcrab.db( DS="set.clean")
      set$sid = paste(set$trip, set$set, sep="~")
      for (f in  outfile) load(f)

      # males
      fn = file.path(  outdir, "male.pdf" )

      #Cairo( file=fn, type="pdf", bg="white", units="in", width=6, height=8 )
      #Cairo( file=fn, type="png", bg="white", units="in", width=6, height=8, dpi=450 )
      pdf(file=fn, width=6, height=8, bg='white')

      ncols = length(areas)
      nrows = length(year)
      pl = layout( matrix( c(1:(ncols*nrows)), nrow=nrows, ncol=ncols, byrow=F ) )
      par(oma=c(5, 4, 4, 1)) # outer margins default:  c(0, 1, 0, 1)'c(bottom, left, top, right)'
      par(mar=c(0, 0, 0.4, 0))

      # ylim=c(0,400) # for 4X
      ylim=c(0,900)
      xlim=c(0,140)
      cols = c("blue3", "darkslategray1")

      for (a in 1:(ncols)) {
        set0 = set[polygon_inside(set, areas[a]),]
        for (y in 1:nrows) {
          set1 = set0[ which(set0$yr==year[y] ), ]
          sids = sort(unique(set1$sid))

          m.i = m.imm[which( rownames(m.imm)%in% sids ) ,]
          m.i.means = apply(X=m.i, MARGIN=2, FUN=mean, na.rm=T)
          m.m = m.mat[which( rownames(m.mat)%in% sids ) ,]
          m.m.means = apply(X=m.m, MARGIN=2, FUN=mean, na.rm=T)

          toplot = rbind(m.m.means, m.i.means)
          rn = as.numeric(colnames(toplot))
          toplot = toplot[, rn>=xlim[1] & rn<=xlim[2]]

          # out = rbind( out, cbind( year[y], toplot))

          axisnames = F
          if (year[y]==year[nrows]) axisnames=T  # last row

          axes = F
          barplot(toplot, space=0, axisnames=axisnames, ylim=ylim, axes=axes, col=cols, xpd=F, lwd=0.5)

          if (areas[a]==areas[1] ) {
            axis(2, las=2, cex=0.5) # first col
          }

          if (areas[a]==areas[ncols]) {
            text( dim(toplot)[2]-4, ylim[2]*2/3, year[y], cex=1 )
          }

          if (areas[a]==areas[3] & year[y] %in% c(1998:2000) ) {
          } else {
            abline( v=41, lwd=1, lty="longdash" )
          }

          if (areas[a]==areas[3] & year[y]==year[1] ) {
            xl = c(xlim[2]*0.1, xlim[2]*0.1)
            yl = c(ylim[2]*0.8, ylim[2]*0.6 )
            points( x=xl, y=yl, pch=22, bg=c(cols[2], cols[1]), cex=2 )
            text( x=xl+xlim[2]*0.02, y=yl-ylim[2]*0.05, c("Immature", "Mature"), cex=1, pos=4)
          }

        }
     }

     mtext("Carapace width (mm)", side=1, outer=T, line=2.5, cex=0.75)
     mtext(expression(paste("No. / ", km^2)), side=2.5, outer=T, line=3, cex=0.75)
     mtext("N-ENS", side=3, outer=T, line=1, at=0.15, cex=0.75)
     mtext("S-ENS", side=3, outer=T, line=1, at=0.5, cex=0.75)
     mtext("4X", side=3, outer=T, line=1, at=0.85, cex=0.75)
     mtext("MALE", side=3, outer=T, line=3, cex=0.75)

  dev.off()
  #cmd( "convert   -trim -quality 9  -geometry 200% -frame 2% -mattecolor white -antialias ", paste(fn, "pdf", sep="."),  paste(fn, "png", sep=".") )

  print(fn)

      # females
  fn = file.path(  outdir, "female.pdf" )

  pdf(file=fn, width=6, height=8, bg='white')
  #Cairo( file=fn, type="png", bg="white", units="in", width=6, height=8, dpi=350 )
  #Cairo( file=fn, type="pdf", bg="white", units="in", width=6, height=8 )

      ncols = length(areas)
      nrows = length(year)
      pl = layout( matrix( c(1:(ncols*nrows)), nrow=nrows, ncol=ncols, byrow=F ) )
      par(oma=c(5, 4, 4, 1)) # outer margins default:  c(0, 1, 0, 1)'c(bottom, left, top, right)'
      par(mar=c(0, 0, 0.4, 0))

      # ylim=c(0,400)
      ylim=c(0,1100)
      xlim=c(0,100)

      cols = c("firebrick1", "lightpink" )

      for (a in 1:(ncols)) {
        set0 = set[polygon_inside(set, areas[a]),]
        for (y in 1:nrows) {
          set1 = set0[ which(set0$yr==year[y]) , ]
          sids = sort(unique(set1$sid))

          f.i = f.imm[which( rownames(f.imm)%in% sids ) ,]
          f.i.means = apply(X=f.i, MARGIN=2, FUN=mean, na.rm=T)
          f.m = f.mat[which( rownames(f.mat)%in% sids ) ,]
          f.m.means = apply(X=f.m, MARGIN=2, FUN=mean, na.rm=T)

          toplot = rbind(f.m.means, f.i.means)
          rn = as.numeric(colnames(toplot))
          toplot = toplot[, rn>=xlim[1] & rn<=xlim[2]]

          axes = F

          axisnames = F
          if (year[y]==year[nrows]) axisnames=T  # last row

          barplot(toplot, space=0.1, axisnames=axisnames, ylim=ylim, axes=axes, col=cols, xpd=F, lwd=0.7 )

           if (areas[a]==areas[1] ) {
            axis(2, las=2, cex=0.5) # first col
          }

          if (areas[a]==areas[ncols]) text( dim(toplot)[2]-4, ylim[2]*2/3, year[y], cex=1.2 )

          if (areas[a]==areas[3] & year[y]==year[1] ) {
            xl = c(xlim[2]*0.18, xlim[2]*0.18)
            yl = c(ylim[2]*0.8, ylim[2]*0.6 )
            points( x=xl, y=yl, pch=22, bg=c(cols[2], cols[1]), cex=2 )
            text( x=xl+xlim[2]*0.01, y=yl-ylim[2]*0.05, c("Immature", "Mature"), cex=1, pos=4)
          }

     }}

      mtext("Carapace width (mm)", side=1, outer=T, line=2.5, cex=0.75)
      mtext(expression(paste("No. / ", km^2)), side=2, outer=T, line=3, cex=0.75)
      mtext("N-ENS", side=3, outer=T, line=1, at=0.15, cex=0.75)
      mtext("S-ENS", side=3, outer=T, line=1, at=0.5, cex=0.75)
      mtext("4X",   side=3, outer=T, line=1, at=0.85, cex=0.75)
      mtext("FEMALE", side=3, outer=T, line=3, cex=0.75)

    dev.off()
 #cmd( "convert   -trim -quality 9  -geometry 200% -frame 2% -mattecolor white -antialias ", paste(fn, "pdf", sep="."),  paste(fn, "png", sep=".") )

  print(fn)

  return("Done")
  }


text:
#' Tall Matrices
#'
#' Many data science problems reduce to operations on very tall,
#' skinny matrices.  However, sometimes these matrices can be so tall that they
#' are difficult to work with, or do not even fit into main memory.  One
#' strategy to deal with such objects is to distribute their rows across
#' several processors.  To this end, we offer an 'S4' class for tall, skinny,
#' distributed matrices, called the 'shaq'.  We also provide many useful
#' numerical methods and statistics operations for operating on these
#' distributed objects.  The naming is a bit "tongue-in-cheek", with the class
#' a play on the fact that 'Shaquille' 'ONeal' ('Shaq') is very tall, and he
#' starred in the film 'Kazaam'.
#'
#' @import pbdMPI
#' @import methods
#' @importFrom stats prcomp optim runif
#' @importFrom float float32 is.float
#'
#' @useDynLib kazaam R_mpicrossprod R_float_mpicrossprod R_add1 R_memcpy
#'   R_km_assign R_km_update R_trinv R_matmult_dgemm
#'
#' @name kazaam-package
#' @docType package
#' @references Programming with Big Data in R Website: \url{http://r-pbd.org/}
#' @keywords Package
NULL

max_stars_repo_name: snoweye/kazaam

max_issues_repo_name: snoweye/kazaam

max_forks_repo_name: snoweye/kazaam


text:
Relocation section '\.rel\.dyn' at offset 0x8000 contains 2 entries:
 Offset     Info    Type            Sym\.Value  Sym\. Name
0001100c  ......a0 R_ARM_IRELATIVE
00011010  ......a0 R_ARM_IRELATIVE

ext: rd

max_stars_repo_name: sillywalk/grazz

max_issues_repo_name: sillywalk/grazz

max_forks_repo_name: sillywalk/grazz


text:
#Incidence matrix for given bipartite n/w
B <- matrix(c(1,1,1,0,0,0,0,0,1,1,1,1,0,0,0,0,0,1,0,1,0,0,0,0,0,1,0,1),byrow = T, 4, 7,
            dimnames = list(c('A','B','C','D'),c(seq(1:7))))
print("Incidence matrix is")
show(B)

#Adjacency matrix for projections
#1.Vertex projection
VB <- B %*% t(B)
print("Adj matrix for vertex projection")
show(VB)

#2.Group projection
GB <- t(B) %*% B
print("Adj matrix for group projection")
show(GB)

max_stars_repo_name: ambirpatel/Complex-Networks-Codes

max_issues_repo_name: ambirpatel/Complex-Networks-Codes

max_forks_repo_name: ambirpatel/Complex-Networks-Codes


text:
library(ggplot2)

# read the file
x1= read.delim("E:/denboer2009-expr.txt")
rownames(x1)= x1[,1]
x3 = x1[,-1]
x= as.data.frame(t(x3))

# read the lables
y= read.delim("E:/denboer2009-pheno (2).txt")
rownames(y)= y[,1]
y= y[,-1]

#compute principal components of gene expressions
pc = prcomp(x)

# plot & save most important pcs
jpeg("PCA.jpg")
plot(pc)
title(sub= "Most important principal components of ALL gene expression data")
dev.off()

# draw & save distribution of different samples among PC1 and PC2
pcx = data.frame(pc$x)
sample = y[,5]
jpeg("2d-pc-scaterplot.jpg")
ggplot(pcx, aes(PC1,PC2, color = sample)) + geom_point(size=3) + labs(caption =
                  "This plot shows the distribution of different samples among PC1 and PC2.
  It illustrates that PC1 & PC2 separate T-cell ALL from B-Cell ALL.
   It is obvious that linear classifiers work well with this mapping. ") +
  theme(plot.caption=element_text(hjust = -0.2))
dev.off()

# 3D scatterplot of PC1, PC2, AND PC3
plot3d(pcx[,1:3], type= 's', col = y[,6], size= 2)