*Answer Q7-10* Convergence in R

[taffy84]

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:

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:

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.

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]

Thank you for your input.

[Necro]

Thank you so much for this. I had exactly the same problem.