Recently I’ve been battling furiously with R while analysing some loop modelling accuracy data. The idea was simple:<\/p>\n
It turns out, it’s not that simple to actually implement. Fitting a general linear model in R produces coefficients in a vector.<\/p>\n
model <- glm(accuracy ~ param1 + param2 * param3, data=trainingset)\r\ncoef(model)<\/pre>\n(Intercept) param1 param2 \r\n 0.435395087 -0.093295388 0.148154339 \r\n param3 param2:param3\r\n 0.024399530 0.021100300<\/pre>\nThere seems to be no easy way to insert these coefficients into your formula and apply the resulting equation to new data. The only easy thing to do is to plot the fitted values against the variable we’re trying to predict, i.e. plot our predictions on the training set itself:<\/p>\n
plot(model$fitted.values, trainingset$accuracy, xlab=\"score\", ylab=\"accuracy\", main=\"training set\")<\/pre>\nI’m sure there must be a better way of doing this, but many hours of Googling led me nowhere. So here is how I did it.\u00a0I ended up writing my own parser function, which works only on very simple formulae using the + and * operators and without any R code inside the formula.<\/p>\n
coefapply <- function(coefficients, row)\r\n{\r\n result <- 0\r\n for (i in 1:length(coefficients))\r\n {\r\n subresult <- as.numeric(coefficients[i])\r\n if (!is.na(subresult))\r\n {\r\n name <- names(coefficients[i])\r\n if (name != \"(Intercept)\")\r\n {\r\n subnames <- strsplit(name, \":\", fixed=TRUE)[[1]]\r\n for (n in subnames)\r\n {\r\n subresult <- subresult * as.numeric(row[n])\r\n }\r\n }\r\n result <- result + subresult\r\n }\r\n }\r\n return(result)\r\n}\r\n\r\ncalculate_scores <- function(data, coefficients)\r\n{\r\n scores <- vector(mode=\"numeric\", length=nrow(data))\r\n for (i in 1:nrow(data))\r\n {\r\n row <- data[i,]\r\n scores[i] <- coefapply(coefficients, row)\r\n }\r\n return(scores)\r\n}<\/pre>\nNow we can apply our formula to a new dataset and plot the accuracy achieved on the new data:<\/p>\n
model_coef <- coef(model)\r\n\r\n# Test if our scores are the same values as the model's fitted values\r\ntraining_scores <- calculate_scores(model_coef, trainingset)\r\nsum((training_scores - model$fitted.values) < 0.000000000001) \/ length(scores)\r\n\r\n# Calculate scores for our test set and plot them\r\ntest_scores <- calculate_scores(model_coef, testset)\r\nplot(test_scores, testset$accuracy, xlab=\"score\", ylab=\"accuracy\", main=\"test set\")<\/pre>\nIt works for my purpose. Maybe one day someone will see this post, chuckle, and then enlighten me with their perfectly simple and elegant alternative.<\/p>\n","protected":false},"excerpt":{"rendered":"
Recently I’ve been battling furiously with R while analysing some loop modelling accuracy data. The idea was simple: Fit a general linear model to some data Get out a formula to predict a variable (let’s call it “accuracy”) based on some input parameters Apply this formula to new data and see how well the predictor […]<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"nf_dc_page":"","wikipediapreview_detectlinks":true,"_monsterinsights_skip_tracking":false,"_monsterinsights_sitenote_active":false,"_monsterinsights_sitenote_note":"","_monsterinsights_sitenote_category":0,"ngg_post_thumbnail":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":""},"categories":[14,15],"tags":[19,18],"ppma_author":[501],"class_list":["post-376","post","type-post","status-publish","format-standard","hentry","category-howto","category-technical","tag-programming","tag-r"],"jetpack_featured_media_url":"","jetpack_sharing_enabled":true,"authors":[{"term_id":501,"user_id":2,"is_guest":0,"slug":"seb","display_name":"Sebastian Kelm","avatar_url":"https:\/\/secure.gravatar.com\/avatar\/7b3bce7bd485f4cfaa499e250df856f941b4c972b74d8a89f4244f0a2595d15a?s=96&d=mm&r=g","0":null,"1":"","2":"","3":"","4":"","5":"","6":"","7":"","8":""}],"_links":{"self":[{"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/posts\/376","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/comments?post=376"}],"version-history":[{"count":11,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/posts\/376\/revisions"}],"predecessor-version":[{"id":388,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/posts\/376\/revisions\/388"}],"wp:attachment":[{"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/media?parent=376"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/categories?post=376"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/tags?post=376"},{"taxonomy":"author","embeddable":true,"href":"https:\/\/www.blopig.com\/blog\/wp-json\/wp\/v2\/ppma_author?post=376"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}