LFD Book Forum

LFD Book Forum (http://book.caltech.edu/bookforum/index.php)
-   Homework 1 (http://book.caltech.edu/bookforum/forumdisplay.php?f=130)
-   -   *Answer Q7-10* Convergence in R (http://book.caltech.edu/bookforum/showthread.php?t=4615)

taffy84 09-06-2015 06:09 AM

*Answer Q7-10* Convergence in R
 
Hello,
I ran into a problem programming this assignment in R (not a particularly good programmer and beginner in R at that). Anyway, wanted to post so others don't waste as much time as I did.

Basically, my code was working except 80% of the time, and failing to converge 20% of the time. It took me a few hours to finally determine the issue.

The function that was causing the issue is sample(input, number of samples).

I had created an R vector by scoring the perceptron called "wrongs" through:
wrongs <-which(scores!=True)
-where scores was a true/false comparison vector with the input scored by the current perceptron versus the input classified by my earlier random line.
Next, to sample the misclassified points I used:

Code:

i <- sample(wrongs, 1)
- this should get me the index(i) of one of the misclassified points, and it does UNLESS there is only 1 misclassified point left. Then it reads the 1 index as a sample up to instead of being the whole space. (IE it was giving me indexes of points that were classified correctly). This caused my algorithm to fail to converge most of the time when it got down to 1 misclassified input.
I fixed this with a simple if/else statement as follows:
Code:

wrongs <- which(scores!=TRUE)
                        if(length(wrongs) > 1){
                                i <- sample(wrongs, 1)
                                }
                        else {
                                i <- wrongs
                                }
                        weight <- updateperceptron(weight, i, input, y)

I have attached the source code below so that you may see the context. Hopefully this saves someone else the hours I spent troubleshooting my algorithm.

Code:

getdataset <- function(n){
        X0 <- rep(1, n)
        X1 <- runif(n, -1, 1)
        X2 <- runif(n, -1, 1)
        Input <- matrix(data = c(X0, X1, X2) , ncol=3)
        return(Input)
}

makeline <- function(){
        xy1 <- runif(2, -1, 1)
        xy2 <- runif(2, -1, 1)
        slope <- (xy1[2] - xy2[2])/(xy1[1] - xy2[1])
        b <- xy2[2] - slope * xy2[1]
        sb <- c(slope, b)
        sb <- as.matrix(sb)
        return(sb)
}

classifyinput <- function(sb, input){
        classy <- input[,2] * sb[1] + sb[2]
        y <- ifelse(classy>input[,3], 1, -1)
        return(y)
}

scoreperceptron <- function(weight, input, y){
        wy <- input %*% weight
        wy <- sign(wy)
        score <- ifelse(wy==y, TRUE, FALSE)
        return(score)
        }

updateperceptron <- function(weight, i, input, y){
        thepoint <- input[i,]
        they <- y[i]
        weight <- weight + (thepoint * they)
        return(weight)

}

calculateerrorprob <- function(weight, k, sb){
        inputs <- getdataset(k)
        ys <- classifyinput(sb, inputs)
        scored <- scoreperceptron(weight, inputs, ys)
        wrongs <- which(scored!=TRUE)
        score <- length(wrongs)/k
        return(score)
       
}
runexperiment <- function(n, maxits, k){
        sb <- makeline()
        input <- getdataset(n)
        y <- classifyinput(sb, input)
        counter <- 0
        weight <- c(0,0,0)
        while(counter < maxits){
                weight <- as.matrix(weight)
                scores <- scoreperceptron(weight, input, y)
                if(all(scores)==TRUE){
                        break}
                else {
                        wrongs <- which(scores!=TRUE)
                        if(length(wrongs) > 1){
                                i <- sample(wrongs, 1)
                                }
                        else {
                                i <- wrongs
                                }
                        weight <- updateperceptron(weight, i, input, y)
                }
                counter <- counter + 1
        }
        #print(counter)
        #print(weight)
        #print(scores)
        #print(wrongs)
        #print(i)
        error <- calculateerrorprob(weight, k, sb)
        return(c(counter, error))
       
       
}

totalexp <- function(trials, n, maxits, k){
                counter <- c(0)
                error <- c(0)
                percents <- c(0)
                trial = 1
                n = n
                maxits = maxits
                k = k
                while (trial < trials){
                        countere <- runexperiment(n, maxits, k)
                        counter[trial] <- countere[1]
                        error[trial] <- countere[2]
                        trial = trial + 1
                }
                print(mean(counter))
                print(sd(counter))
                print(median(counter))
                print(mean(error))
                print(sd(error))
                print(median(error))
        }


yaser 09-06-2015 05:10 PM

Re: *Answer Q7-10* Convergence in R
 
Thank you for your input.

Necro 12-17-2015 10:23 AM

Re: *Answer Q7-10* Convergence in R
 
Thank you so much for this. I had exactly the same problem. :)


All times are GMT -7. The time now is 08:30 PM.

Powered by vBulletin® Version 3.8.3
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
The contents of this forum are to be used ONLY by readers of the Learning From Data book by Yaser S. Abu-Mostafa, Malik Magdon-Ismail, and Hsuan-Tien Lin, and participants in the Learning From Data MOOC by Yaser S. Abu-Mostafa. No part of these contents is to be communicated or made accessible to ANY other person or entity.