#
# gpw.chromosome
#
library(methods)
library(uuid)
setValidity("gpw.chromosome", function (object) {
isValid <- TRUE
msg <- NULL
if (isValid && object@stockName %!in% gpw.getValidSymbols(object@stockData)) {
isValid <- FALSE
msg <- paste('Invalid stock name:', object@stockName)
}
if (isValid && object@futureRelativeTimePos %!in% gpw.getValidTimespans(object@stockData)) {
isValid <- FALSE
msg <- paste('Invalid futureRelativeTimePos:', object@futureRelativeTimePos)
}
if (isValid && length(object@gene) < 1) {
isValid <- FALSE
msg <- paste('Empty gene')
}
if (isValid && !all(vapply(object@gene, function (x) identical(x@stockData, object@stockData), FALSE))) {
isValid <- FALSE
msg <- paste('mixed stock data')
}
if (isValid && nrow(object@stockRecords) == 0) {
isValid <- FALSE
msg <- paste('stockRecords is empty')
}
if (isValid) TRUE else msg
})
setMethod("as.character",
"gpw.chromosome",
function(x) paste(
paste(if (x@isOptimistic) "+" else "-", x@stockName, 'over', x@futureRelativeTimePos, 'timeshift, genes:'),
paste(lapply(x@gene, function(gene) paste('"', as.character(gene), '"')), collapse = '\n'),
sep = '\n'
)
)
setMethod("show", "gpw.chromosome", function(object) cat(as.character(object)))
setMethod("length", "gpw.chromosome", function(x) length(x@gene))
normalizeGeneList <- function (geneList) {
usedNames = NULL
resultMap = NULL
for (gene in geneList) {
geneSignature <- gpw.signature(gene)
precedense <- geneSignature %!in% usedNames
resultMap <- c(resultMap, precedense)
if (precedense) {
usedNames <- c(usedNames, geneSignature)
}
}
filteredResult <- geneList[resultMap]
filteredResult[order(usedNames)]
}
setMethod("as.gpw.chromosome",
c(stockData = "gpw.relative"),
function (stockData, stockName, futureRelativeTimePos, isOptimistic, genesCount, valueSdPerOperator, normalizeGeneFunc) {
normalizeGene <- if(missing(normalizeGeneFunc)) normalizeGeneList else normalizeGeneFunc
actualGenesCount <- if(missing(genesCount)) gpw.randomInteger(10) else genesCount
medians <- if (missing(valueSdPerOperator)) gpw.geneAggregatorAbsMedian(stockData) else valueSdPerOperator
geneList <- lapply(c(1:actualGenesCount), function (x) gpw.randomGene(stockData, valueSdPerOperator = medians))
stockRecords <- subset(stockData, symbol == stockName & timespan == futureRelativeTimePos)
gpw.chromosome(
id = uuid::UUIDgenerate(),
stockData = stockData,
stockName = stockName,
futureRelativeTimePos = futureRelativeTimePos,
isOptimistic = isOptimistic,
gene = gpw.geneList(listData = normalizeGene(geneList)),
stockRecords = stockRecords
)
})
setMethod("gpw.isTheSameSpiece",
c(x = "gpw.chromosome", y = "gpw.chromosome"),
function (x, y) {
x@stockName == y@stockName && x@futureRelativeTimePos == y@futureRelativeTimePos
})
setMethod("gpw.getFitness",
c(x = "gpw.chromosome"),
function (x, timestampPos) {
record <- subset(x@stockRecords, timestamp_pos == as.integer(timestampPos))
if (nrow(record) == 0) stop(paste('Invalid timestampPos:', timestampPos, 'valid ones:', x@stockRecords$timestamp_pos))
isEnabled <- all(vapply(x@gene, function (x) gpw.isEnabled(x, timestampPos), TRUE))
value <- gpw.getPriceCloseRelative(record)
if (isEnabled) (
if (x@isOptimistic) value else -1 * value
) else 0
})
setMethod("gpw.mutate",
c(x = "gpw.chromosome"),
function(x, mutationRate) {
geneList <- lapply(x@gene, function (g) gpw.mutate(g, mutationRate))
gpw.chromosome(
id = uuid::UUIDgenerate(),
stockData = x@stockData,
stockName = x@stockName,
futureRelativeTimePos = x@futureRelativeTimePos,
isOptimistic = x@isOptimistic,
gene = gpw.geneList(listData = normalizeGeneList(geneList)),
stockRecords = x@stockRecords
)
})
chromosomalCrossover <- function(x, y) {
geneCrossover <- as.gpw.geneCrossover(x@gene, y@gene)
geneReproduction <- gpw.reproduce(geneCrossover)
geneList <- gpw.geneList(listData = normalizeGeneList(geneReproduction@listData))
xChromosome <- gpw.chromosome(
id = uuid::UUIDgenerate(),
stockData = x@stockData,
stockName = x@stockName,
futureRelativeTimePos = x@futureRelativeTimePos,
isOptimistic = x@isOptimistic,
gene = geneList,
stockRecords = x@stockRecords
)
yChromosome <- gpw.chromosome(
id = uuid::UUIDgenerate(),
stockData = y@stockData,
stockName = y@stockName,
futureRelativeTimePos = y@futureRelativeTimePos,
isOptimistic = y@isOptimistic,
gene = geneList,
stockRecords = y@stockRecords
)
gpw.chromosomeList(listData = list(xChromosome, yChromosome))
}
setMethod("gpw.crossover",
c(x = "gpw.chromosome", y = "gpw.chromosome"),
function(x, y, crossoverRate, randomNumberGenerator) {
if (missing(randomNumberGenerator))
selectedNumber <- runif(1)
else
selectedNumber <- randomNumberGenerator()
if (crossoverRate >= selectedNumber)
chromosomalCrossover(x, y)
else
NULL
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.