Manhattan distance in R - r

I am going to calculate manhattan distance in R but I have a problem how to check if there exist a key in the hash.
My code is as follow. The error I am getting is in line with if statement.
library("hash")
h <- hash( list( Tom=list( Film1=4.0, Film2=1.0, Film3=4.0, Film4=4.0, Film5=1.0 ), Jon=list( Film1=3.0, Film2=5.0, Film3=4.0, Film4=2.5, Film5=3.0 ) ) )
manhattan_dist <- function(rating1, rating2){
distance <- 0
for(key in rating1){
if( has.key( key, rating2 ))
distance <- distance + (abs(rating1[[1]] - rating2[[1]]))
}
return(distance)
}
dist <- manhattan_dist(h$Tom, h$Jon)
dist
And the error is:
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘has.key’ for signature ‘"numeric", "list"’

should work like this if you pass vector
manhattan_dist <- function(rating1, rating2){
distance <- abs(rating1-rating2)
distance <- sum(distance)
return(distance)
}

Related

Normalization of cel. files after filtering of non-expressed genes in R

Before normalizing my data, I want to perform a filtering where genes that are not expressed are deleted. For this purpose I have specified a threshold value. I would like to do this filtering before normalizing and then normalize it.
library(limma)
library(hgu133plus2cdf)
library(affy)
library(dplyr)
library(oligo)
setwd("C:/A549_ALI/4_tert-Butanol (22)/")
data=read.celfiles(list.celfiles())
eset <- rma(data, normalize=FALSE, background=FALSE)
not_expressed_threshold <- quantile(exprs(eset),0.1)
not_expressed <- exprs(eset) < not_expressed_threshold
not_expressed_2 <- rownames(exprs(eset))[not_expressed]
celfiles_filtered <- eset[!rownames(eset) %in% not_expressed_2, ]
cat("Dimensions of celfiles:", dim(eset), "\n")
cat("Dimensions of celfiles_filtered:", dim(celfiles_filtered), "\n")
eset_ <- rma(celfiles_filtered, normalize=FALSE, background=FALSE)
I get this error message:
Error in (function (classes, fdef, mtable) :
cannot find inherited method for function 'rma' for signature '"ExpressionSet"'.
I tried to filter data directly and then normalize it, but it didn't work either. Thanks for any reply.

unable to find an inherited method for function 'distance' for signature '"matrix", "character"', but it's a df?

Here is all my code leading up to the function as per #Till request!
library("phyloseq")
library("qiime2R")
library("vegan")
# read in phyloseq objects from qiime
physeq<-qza_to_phyloseq(
features="~/Documents/qiime2-analyses/CRD/fresh_run/table.qza",
tree="~/Documents/qiime2-analyses/CRD/fresh_run/rooted-tree.qza",
"~/Documents/qiime2-analyses/CRD/fresh_run/taxonomy.qza",
metadata = "crd-metadata.txt")
# Clean out unwanted taxa annotations. Base script removes endozoicimonaceae, escherischia,
# and shigella contaminates
physeq <- subset_taxa(physeq, Family!="f__Endozoicimonaceae")
physeq <- subset_taxa(physeq, Family!="f__Enterobacteriaceae")
physeq <- subset_taxa(physeq, Family!="f__mitochondria")
physeq <- subset_taxa(physeq, Class!="c__Chloroplast")
#pull out otu table
otu_table <- (as.data.frame(otu_table(physeq)))
# rotate otu matrix layout
rownames(otu_table) <- factor(rownames(otu_table), levels = rownames(otu_table))
otu_ord <- as.data.frame(t(otu_table[rowSums(otu_table)!=0, ]))
# remove any rows or columns with only 0s
otu_ord <- otu_ord[, colSums(otu_ord !=0)>0]
otu_ord <- otu_ord[rowSums(otu_ord[])>0,]
#edits from observations of this StO chat
rownames(otu_ord) <- gsub("sample-", "", rownames(otu_ord))
rownames(otu_ord) <- as.numeric(rownames(otu_ord))
otu_ord <- as.matrix(otu_ord)
#the args of the function
raup_crick_abundance = function(spXsite=otu_ord, plot_names_in_col1=TRUE,
classic_metric=FALSE, split_ties=TRUE,
reps=9999, set_all_species_equal=FALSE,
as.distance.matrix=TRUE, report_similarity=FALSE){
Please note the whole function is verbatim from Stegen_etal_ISME_2013 github linked below and here.
I am receiving the error
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘distance’ for signature ‘"matrix", "character"’
Called from: (function (classes, fdef, mtable)
{
methods <- .findInheritedMethods(classes, fdef, mtable)
if (length(methods) == 1L)
return(methods[[1L]])
else if (length(methods) == 0L) {
cnames <- paste0("\"", vapply(classes, as.character,
""), "\"", collapse = ", ")
stop(gettextf("unable to find an inherited method for function %s for signature %s",
sQuote(fdef#generic), sQuote(cnames)), domain = NA)
}
else stop("Internal error in finding inherited methods; didn't return a unique method",
domain = NA)
})(list("matrix", "character"), new("nonstandardGenericFunction",
.Data = function (physeq, method, type = "samples", ...)
{
standardGeneric("distance")
}, generic = "distance", package = "phyloseq", group = list(),
valueClass = character(0), signature = c("physeq", "method",
"type"), default = NULL, skeleton = (function (physeq, method,
type = "samples", ...)
stop("invalid call in method dispatch to 'distance' (no default method)",
domain = NA))(physeq, method, type, ...)), <environment>)
Browse[1]> traceback()
No traceback available
within this function linked here.
My argument is a data.frame (dput() below) with no character strings? As I understand it, the error is saying the function distance () can't be calculated with matrix or character strings, which I agree with...
Therefore, I am unsure why distance () cannot operate with my arg, if I am interpreting the error correctly.
Thank you.
Here is my Qiime2 OTU table.qza linked to this Dropbox file, my rooted tree linked here, and my taxonomy linked here to recreate my phyloseq object.
What the error message is actually trying to get across is that your matrix has character values and the function you called can not handle it. The first column in data.frame is a character column.
If your data frame is called ex_otu_ord, try this:
ex_otu_ord <- ex_otu_ord[-1]
ex_otu_ord <- as.matrix(ex_otu_ord)
Then try again to call the function on ex_otu_ord.

R: overwrite rules that apriori produced

I want to overwrite confidence values of an apriori output, then put the output into is.redundant. I got an error at the last line. How do you do it?
library(arules)
data(Groceries) # read sample data
# find apriori rules
outApriori = apriori(Groceries,
parameter = list(support=0.001, confidence=0.70, minlen=1, maxlen=4)
,appearance = list(rhs = "whole milk" ) )
dfApriori = as.data.frame(inspect(outApriori[1:5])) # convert into data.frame
# modify the confidence value conservatively by adding one error sample
(estimateConfidence= dfApriori$count / (1 + round( dfApriori$count / dfApriori$confidence ) ))
dfApriori$confidence = estimateConfidence
outRmRedundant <- dfApriori[!is.redundant(dfApriori)] # Error in (function (classes, fdef, mtable) :
# Error in (function (classes, fdef, mtable) :
# unable to find an inherited method for function ‘is.redundant’ for signature ‘"data.frame"’
The function is.redundant() expects a rules object not a data.frame. Here is how you change the quality slot of the rules object:
library(arules)
data(Groceries)
# find apriori rules
rules <- apriori(Groceries,
parameter = list(support=0.001, confidence=0.70, minlen=1, maxlen=4),
appearance = list(rhs = "whole milk"))
estimatedConfidence <- quality(rules)$count / (1 + round(quality(rules)$count / quality(rules)$confidence))
quality(rules)$confidence <- estimatedConfidence
rules.nonredundant <- rules[!is.redundant(rules)]
inspect(head(rules.nonredundant))
BTW: You might want to look at Laplace Corrected Confidence (http://michael.hahsler.net/research/association_rules/measures.html#laplace) which can be calculated using the function interestMeasure().

error with RBGL package in R

I want to install the RGBL package in bioconductor to perform some graph algorithms.
I updated R to the latest version 3.2.0, and installed the package as instructed on http://www.bioconductor.org/
source("http://bioconductor.org/biocLite.R")
biocLite("RBGL")
It was installed successfully, then I tried to run
library(graph)
library(RBGL)
x<- strongComp(graph)
and returns this error
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘isDirected’ for signature ‘"igraph"’
Here's the traceback
> traceback()
4: stop(gettextf("unable to find an inherited method for function %s for signature %s",
sQuote(fdef#generic), sQuote(cnames)), domain = NA)
3: (function (classes, fdef, mtable)
{
methods <- .findInheritedMethods(classes, fdef, mtable)
if (length(methods) == 1L)
return(methods[[1L]])
else if (length(methods) == 0L) {
cnames <- paste0("\"", vapply(classes, as.character,
""), "\"", collapse = ", ")
stop(gettextf("unable to find an inherited method for function %s for signature %s",
sQuote(fdef#generic), sQuote(cnames)), domain = NA)
}
else stop("Internal error in finding inherited methods; didn't return a unique method",
domain = NA)
})(list("igraph"), function (object)
standardGeneric("isDirected"), <environment>)
2: isDirected(g)
1: strongComp(graph)
My system is Windows 32-bit.
I'm not sure if this is enough information. Please let me know if any other information needed.
Any ideas are appreciated, thanks!
EDIT:
I used the igraph packaged to create the graph object from an edge list with weight
library(igraph)
graph<- graph.data.frame(edge.list[,c(2:4)],directed=TRUE)
I'm not very good with generating random number, here's a reproducible example for my graph
set.seed(123)
edge.list<-cbind(seq(10),c(1,1,2,3,3,4,5,5,5,5),c(2,2,3,5,4,3,4,4,4,2),
runif(10, 1, 30))
colnames(edge.list) <-c("ID","V1","V2","weight")
As pointed out in the comments, you need to make a graph object, not an igraph object.
Here's how I might transform your edge.list into the form that graph expects.
rawEL <- data.frame(source = as.character(edge.list[,1]),
edges = as.character(edge.list[,2]),
weights = edge.list[,3], stringsAsFactors=F
)
V <- unique(c(rawEL$source, rawEL$edges))
edL <- lapply(
split(
rawEL[,-1],
factor(edge.list[,1], levels=V)
), as.list
)
gr <- graphNEL(V, edL, "directed")
plot(gr)

How to set up libraries for fPortfolio and call pfolioTargetReturn

I'm debugging another author's code. I think the code is right, but my system is setup wrong. It's calling a function from a package, and getting an error message:
> fPortfolio::pfolioTargetReturn( Data, weights = wgts )
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘series<-’ for signature ‘"numeric", "matrix"’
The error messages itself says it can't find the method for this function signature, which means that the function call signature is wrong, or that the method isn't loaded or is obscured.
The parameters (Data & wgts) seem to be properly formed:
> str(Data)
Time Series:
Name: object
Data Matrix:
Dimension: 431 13
...
> str( wgts )
Named num [1:13] 0.038 0.1467 0.038 0.3 0.0228 ...
and the same parameters sent to pfolioTargetRisk seem to work okay:
> fPortfolio::pfolioTargetRisk( Data, weights = wgts )
TargetRisk
0.002415664
and if I replace wgts with a simpler vector, I get the same error:
> pfolioTargetReturn(Data, weights = rep(x=1/13, times=13))
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘series<-’ for signature ‘"numeric", "matrix"’
I installed the library in many different ways: originally from my predecessor's packrat; most lately as per the contributors' wiki at https://wiki.rmetrics.org/install_rmetrics. So I think I have all dependencies set up. I think the problem is on my search path: that there's another "series <-" function set up in another package, obscuring mine. My search path is:
> search()
[1] ".GlobalEnv" "package:fPortfolio" "package:fAssets" "package:fBasics"
[5] "package:xts" "package:zoo" "package:timeSeries" "package:timeDate"
[9] "package:knitr" "tools:rstudio" "package:stats" "package:graphics"
[13] "package:grDevices" "package:utils" "package:datasets" "package:methods"
[17] "Autoloads" "package:base"
How can I resolve this error message?
Update:
I've stepped thru the functions in the fPortfolio library, and arrived at a line where I get the same result
> series( Return ) <- x %*% weights
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘series<-’ for signature ‘"numeric", "matrix"’
which clearly fits everything we've seen so far. x has long since been cast as.matrix(Data), and weights is my rep(x=1/13, times=13) vector.
> dim(x)
[1] 431 13
> length(weights)
[1] 13
> str( x %*% weights )
num [1:431, 1] 0.002000 -0.000000 -0.001000 0.002000 0.002000 ...
- attr(*, "dimnames")=List of 2
..$ : chr [1:431] "2012-05-17" "2012-05-20" "2012-05-21" "2012-05-22" ...
..$ : NULL
but it would seem to me that a 431x13 matrix matrix-multiplied by a 13 length vector should come up with a 431x1 matrix or a 431-length vector, and it looks like R is taking it as a 431x1 matrix. It looks to me like the series(Return) fails similarly
> series(Return)
Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘series’ for signature ‘"numeric"’
> str(Return)
Named num [1:431] -0.00100 -0.00200 -0.00500 -0.00200 0.00800 ...
- attr(*, "names")= chr [1:431] "2012-05-17" "2012-05-20" "2012-05-21" "2012-05-22" ...
So tracing thru the library, I find that my call
pfolioTargetReturn( Data, weights = wgts )
gets sent to
> pfolioTargetReturn
function (x, weights = NULL)
{
x = as.matrix(x)
ans = mean(pfolioReturn(x = x, weights = weights))
names(ans) = "TargetReturn"
ans
}
<environment: namespace:fPortfolio>
> pfolioReturn
function (x, weights = NULL, geometric = FALSE)
{
weights <- as.vector(weights)
if (geometric) {
X <- t(colCumprods(1 + x) - 1)
X <- rbind(diff(t(X * weights)))
Return <- x[, 1]
series(Return[+1, ]) <- x[1, ] %*% weights
series(Return[-1, ]) <- rowSums(X)
}
else {
Return <- x[, 1]
series(Return) <- x %*% weights
}
colnames(Return) <- "pfolioRet"
Return
}
<environment: namespace:fPortfolio>
which starts by sending my Data to x, and then casting it to a matrix in x = as.matrix(x), and then sending it to pfolioReturn, where (since I left the geometric out, it defaults to FALSE). The my wgts get sent to weights which get cast to a vector in weights <- as.vector(weights). Then
Return <- x[, 1]
series(Return) <- x %*% weights
Return comes back as a 431 length vector. x %*% weights becomes that 431x1 matrix (discussed above), which is what we need. series <- calls for a timeSeries and a matrix. I have a vector and a matrix. So now I'm thinking that the problem is the vector Return not being timeSeries. My Data started as a timeSeries, and the fPortfolio library changed it to a vector in Return <- x[, 1].
If I haven't made some kind of installation error (which I still sorta' can't believe), then you've just helped me find a bug in the library. I added a line Return <- as.timeSeries(Return) to the pfolioReturn function, and now I'm getting an answer.
I get the same error. timeSeries::'series<-' is expecting a matrix and you are not giving it one. First find the problem function in the error message:
getAnywhere(`series<-`)
#----------
A single object matching ‘series<-’ was found
It was found in the following places
namespace:timeSeries
# snipped rest of output-----------
Then see what it expects as arguments:
showMethods(timeSeries::`series<-`, includeDefs=TRUE)
#-------------------
Function: series<- (package timeSeries)
x="timeSeries", value="ANY"
function (x, value)
{
callGeneric(x, as(value, "matrix"))
}
x="timeSeries", value="matrix"
function (x, value)
{
if (identical(dim(x), dim(value))) {
x#.Data <- value
if (!is.null(cn <- colnames(value)))
colnames(x) <- cn
return(x)
}
#snipped rest of definiton:
The first thing it did was check for dimensional congruence although the code never got there because the signature was not satisfied:

Resources