Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 7 years ago.
Improve this question
I wrote a code for dbscan algorithm.
when I call a function in main
It doesnt work and I dont know why
here is the code
x=read.delim("C:/Users/mf/Desktop/stp.txt")
y=read.delim("C:/Users/mf/Desktop/stp.txt")
hash=0
c=temp1=0
q=1
C=0
eps=30
MinPts=30
lable=matrix(-2,1,nrow(x))
clusterlab=matrix(-3,1,nrow(x))
for(p in 1:nrow(x))
{
if(lable[p]==-2)
{
lable[p]=1 #visited=1 and nonvisited=-2
NeighborPts = regionQuery(p, eps)
temp=nrow(NeighborPts)-1
if (temp < MinPts){
clusterlab[p]=0 #noise = 0
}
else if(temp>=MinPts){
C = C+1
haha=expandCluster(p, NeighborPts, C, eps, MinPts,hash,clusterlab,lable)
}
}
}
expandCluster <- function(p, NeighborPts, C, eps, MinPts,hash,clusterlab,lable) {
hash=hash+1
clusterlab[p]=C
for (q in 2:nrow(NeighborPts))
{ testP=NeighborPts[q,1]
if(lable[testP]==-2)
lable[testP]=1
newNeighborPts = regionQuery(testP, eps)
if ((nrow(newNeighborPts)-1) >= MinPts)
NeighborPts = rbind(NeighborPts,newNeighborPts)
if(clusterlab[testP]==-3) #is not yet member of any cluster
clusterlab[testP]=C
}
return(hash)
}
regionQuery <- function(p, eps) {
neighborhood=p
for(i in 1:nrow(x)){
temp=sqrt((x[p,1]-y[i,1])^2+(x[p,2]-y[i,2])^2)
if(temp<eps){
c=c+1
neighborhood=rbind(neighborhood,i)}
}
#neighborhood=neighborhood[-1,]
return(neighborhood)
}
when I call
haha=expandCluster(p, NeighborPts, C, eps, MinPts,hash,clusterlab,lable)
It doesnt work!!
I add hash variable to check it.
every time that expancdCLuster called hash must incease. but it doesned increased.
lable and clusterlab is not change too.
data is
here
Functions in R are usually designed to pass parameters by value and not by reference. Updating the value of the variables passed in will not change them in the calling environment. Generally speaking, the R way to do this is for your function to return the updated data. If you want to return more than one updated variable, you can use a list to do this.
You will see people using the assign to parent environment operator (<<-) and even assign to the global environment within functions. This style of coding works, but it goes against the principle that functions generally don't modify the calling environment and may make debugging and integrating different pieces of code into a larger project much harder.
Related
hello i created the following functions that test reliability. however i want to combine them into one function like :reliability<-function(x)in order for them to give me a 1-0 matris showing each answer for each function with in "reliability". because each has been giving me the answer on its own. if any ideas help.
splithalf1<- function( data ) {
n<-ncol(data)
tek<-data[ , seq(1,n , 2)]
cift<-data[ , seq(2 ,n , 2)]
top_single<-rowSums(single)
top_double<-rowSums(double)
kor<-cor(top_single,top_double)
r<-2*kor / (1+kor)
return(r)
}
cr.alpha2<- function(x) {
n<-ncol(x)
kov<-cov(x)
kov1<-as.vector(kov)
kov2<-unique (kov1)
kov3<- kov2[-1]
kov4<-sum(kov3)/length(kov3)
pay<- n*kov4
payd<- (1 + (n-1)*kov4)
alpha<-pay/payd
return(alpha)
}
kr20<-function(x) {
n<-ncol(x)
pq<-function(x) {
p<-mean(x)
q<-1-p
res<-p*q
return (res)
}
pay<- sum(apply(x,2,pq))
top<-rowSums(x)
payda<-var(top)
result<- n /(n-1)* (1-(pay/payda))
return(result)
}
Stack is not a coding service! As a teaching service to you, however, I will suggest several things which is probably the intent of your teacher in the first place!
Study up on fundamental R. There are innumerable (well numerable but innumerable for all practical individual purposes) resources for free on the net. One good (IMO), free, intro-to-journeyman-level book is R for Data Science which can be accessed here: https://r4ds.had.co.nz/
check out assigning function return values to vars.
check out the c() and matrix() functions.
I have been given following code for R, but I am having trouble understanding what it is doing. In fact I can not even run it in R because of its syntax. I assume the syntax is for lower level code behind R. If someone could help explain what's happening here and translate this into executable R code that would be very helpful.
soft_thresholding = function(x,a){
result a)] a)] - a
result[which(x < -a)] = x[which(x < -a)] + a
return(result)}
Here is a summary of the findings. This is not a definite answer but could help the questioner.
If one uses wordpress, then x <- a will look like x < -a. Check this URL that confirms this assumption
Upon further online search with the function name in the question "soft_thresholding", shows that this function is probably attempting to do soft thresholding defined here.
Some more online searching about soft thresholding lands on a CRAN package that is present here.
Further deepdive into the r folder in the package binaries shows the following.
soft.threshold <- function(x,sumabs=1)
return(soft(x, BinarySearch(x,sumabs)))
The function above seems very close to the code in the question.
Furthermore, the soft.threshold function uses another internal function BinarySearch that looks like this.
BinarySearch <-
function(argu,sumabs){
if(norm2(argu)==0 || sum(abs(argu/norm2(argu)))<=sumabs) return(0)
lam_max = max(abs(argu))
lam1 <- 0
lam2 <- lam_max
iter <- 1
while(iter < 500){
su <- soft(argu,(lam1+lam2)/2)
if(sum(abs(su/norm2(su)))<sumabs){
lam2 <- (lam1+lam2)/2
} else {
lam1 <- (lam1+lam2)/2
}
if((lam2-lam1)/lam1 < 1e-10){
if (lam2 != lam_max){
return(lam2)
}else{
return(lam1)
}
}
iter <- iter+1
}
warning("Didn't quite converge")
return((lam1+lam2)/2)
}
This recursive research leads one to believe that the function is perhaps attempting to mimic the function soft.threshold in the CRAN package "RGCCA"
Hope it helps
i tried updating data in dataframe but its unable to get updating
//Initialize data and dataframe here
user_data=read.csv("train_5.csv")
baskets.df=data.frame(Sequence=character(),
Challenge=character(),
countno=integer(),
stringsAsFactors=FALSE)
/Updating data in dataframe here
for(i in 1:length((user_data)))
{
for(j in i:length(user_data))
{
if(user_data$challenge_sequence[i]==user_data$challenge_sequence[j]&&user_data$challenge[i]==user_data$challenge[j])
{
writedata(user_data$challenge_sequence[i],user_data$challenge[i])
}
}
}
writedata=function( seqnn,challng)
{
#print(seqnn)
#print(challng)
newRow <- data.frame(Sequence=seqnn,Challenge=challng,countno=1)
baskets.df=rbind(baskets.df,newRow)
}
//view data here
View(baskets.df)
I've modified your code to what I believe will work. You haven't provided sample data, so I can't verify that it works the way you want. I'm basing my attempt here on a couple of common novice mistakes that I'll do my best to explain.
Your writedata function was written to be a little loose with it's scope. When you create a new function, what happens in the function technically happens in its own environment. That is, it tries to look for things defined within the function, and then any new objects it creates are created only within that environment. R also has this neat (and sometimes tricky) feature where, if it can't find an object in an environment, it will try to look up to the parent environment.
The impact this has on your writedata function is that when R looks for baskets.df in the function and can't find it, R then turns to the Global Environment, finds baskets.df there, and then uses it in rbind. However, the result of rbind gets saved to a baskets.df in the function environment, and does not update the object of the same name in the global environment.
To address this, I added an argument to writedata that is simply named data. We can then use this argument to pass a data frame to the function's environment and do everything locally. By not making any assignment at the end, we implicitly tell the function to return it's result.
Then, in your loop, instead of simply calling writedata, we assign it's result back to baskets.df to replace the previous result.
for(i in 1:length((user_data)))
{
for(j in i:length(user_data))
{
if(user_data$challenge_sequence[i] == user_data$challenge_sequence[j] &&
user_data$challenge[i] == user_data$challenge[j])
{
baskets.df <- writedata(baskets.df,
user_data$challenge_sequence[i],
user_data$challenge[i])
}
}
}
writedata=function(data, seqnn,challng)
{
#print(seqnn)
#print(challng)
newRow <- data.frame(Sequence = seqnn,
Challenge = challng,
countno = 1)
rbind(data, newRow)
}
I'm not sure what you're programming background is, but your loops will be very slow in R because it's an interpreted language. To get around this, many functions are vectorized (which simply means that you give them more than one data point, and they do the looping inside compiled code where the loops are fast).
With that in mind, here's what I believe will be a much faster implementation of your code
user_data=read.csv("train_5.csv")
# challenge_indices will be a matrix with TRUE at every place "challenge" and "challenge_sequence" is the same
challenge_indices <- outer(user_data$challenge_sequence, user_data$challenge_sequence, "==") &
outer(user_data$challenge, user_data$challenge, "==")
# since you don't want duplicates, get rid of them
challenge_indices[upper.tri(challenge_indices, diag = TRUE)] <- FALSE
# now let's get the indices of interest
index_list <- which(challenge_indices,arr.ind = TRUE)
# now we make the resulting data set all at once
# this is much faster, because it does not require copying the data frame many times - which would be required if you created a new row every time.
baskets.df <- with(user_data, data.frame(
Sequence = challenge_sequence[index_list[,"row"]],
challenge = challenge[index_list[,"row"]]
)
HI i just started learning R and finding this problem to be really interesting where I just run a code directly without wrapping in a function it works but when I place it inside a function it doesn't work, What can be possible reason?
fill_column<-function(colName){
count <- 0
for(i in fg_data$particulars) {
count <- count +1
if(grepl(colName, i) && fg_data$value[count] > 0.0){
fg_data[,colName][count] <- as.numeric(fg_data$value[count])
} else {
fg_data[,colName][count] <- 'NA'
}
}
}
fill_column('volume')
Where I am creating new column named volume it this string exists in particulars column.
I have added a comment where solution given by another question does not work for me, Please look at my comment below.
Finally I got it working but reading another answer on SO, here is the solution:
fill_column <- function(colName){
count <- 0
for(i in fg_data$particulars) {
count <- count +1
if(grepl(colName, i) && fg_data$value[count] > 0.0){
fg_data[,colName][count] <- as.numeric(fg_data$value[count])
} else {
fg_data[,colName][count] <- 'NA'
}
}
return(fg_data)
}
fg_data = fill_column('volume')
Now reason, Usually in any language when we modify global object inside any function it reflects on global object immediately but in R we have to return the modified object from function and then assign it again to global object to see our changes. or another way for doing this is to assign local object from within the function to global context using envir=.GlobalEnv.
I am having a very hard time trying to subtract two vectors in my OpenBUGS model. The last line of the code below keeps giving the error "expected right parenthesis error":
model {
for ( i in 1:N) {
for(j in 1:q) {
vv[i,j] ~ dnorm(vz[i,j],tau.eta[j])
}
vz[i,1:q] ~ dmnorm(media.z[i,], K.delta[,])
for(j in 1:q) {
mean.z[i,j] <- inprod(K[i,] , vbeta[j,])
}
K[i,1] <- 1.0
for(j in 1:N) {
K[i,j+1] <- sum(ve[,i] - ve[,j])
}
}
If I change that line to K[i,j+1] <- sum(ve[,i]) - sum(ve[,j]), then the model works fine, but that is not what I want to do. I would like to subtract element-wise.
I searched SO for OpenBUGS, but there are only a few unrelated topics:
OpenBUGS - Variable is not defined
OpenBUGS: missing value in Bernoulli distribution
In Stats Stack Exchange there is this post which is close, but I still could not make how to implement this in my model:
https://stats.stackexchange.com/questions/20653/vector-multiplication-in-bugs-and-jags/20739#20739
I understand I have to write a for loop, but this thing is sure giving me a big headache. :)
I tried changing that line to:
for(k in 1:p) { temp [k] <- ve[k,i] - ve[k,j] }
K[i,j+1] <- sum(temp[])
where 'p' is the number of rows in each 've'. Now I keep getting the error "multiple definitions of node temp[1]".
I could definitely use some help. It will be much appreciated.
Best regards to all and thanks in advance!
PS: I wanted to add the tag "OpenBUGS" to this question but unfortunately I couldn't because it would be a new tag and I do not have enough reputation. I added "winbugs" instead.
The "multiple definitions" error is because temp[k] is redefined over and over again within a loop over i and another loop over j - you can only define it once. To get around that, use i and j subscripts like
for(k in 1:p) { temp[k,i,j] <- ve[k,i] - ve[k,j] }
K[i,j+1] <- sum(temp[,i,j])
Though if that compiles and runs, I'd check the results to make sure that's exactly what you want mathematically.