Advertisement
Guest User

Untitled

a guest
Sep 28th, 2016
64
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.16 KB | None | 0 0
  1. # Map 1-based optional input ports to variables
  2. library(forecast)
  3. masefun <- function(observed, predicted){
  4. error = 0;
  5. if (length(observed) != length(predicted)) {
  6. return (NA);
  7. } else if (length(observed) == 0 || length(predicted) == 0) {
  8. return (NA);
  9. }
  10. else {
  11. denom = (sum(abs(observed[2:length(observed)] - observed[1:(length(observed) - 1)])))/(length(observed) - 1)
  12. error = sum((abs(observed-predicted)) / denom)/length(observed);
  13. }
  14. return (error);
  15. }
  16.  
  17.  
  18. smape <- function(observed, predicted){
  19. error = 0;
  20. if (length(observed) != length(predicted)) {
  21. return (NA);
  22. } else if (length(observed) == 0 || length(predicted) == 0) {
  23. return (NA);
  24. }
  25. else {
  26. error = sum((abs(observed-predicted)) / (observed+predicted))/length(observed);
  27. # denom = (sum(abs(observed[2:length(observed)] - observed[1:(length(observed) - 1)])))/(length(observed) - 1)
  28. # error = sum((abs(observed-predicted)) / denom)/length(observed);
  29. }
  30. return (100.0*error);
  31. }
  32.  
  33.  
  34.  
  35. evaluateTimeSeries<-function(dataset1, obsd, fcst, algo) {
  36. orig_names <- names(dataset1)
  37.  
  38. dataidx <- which((orig_names %in% obsd))
  39. fcstidx <- which((orig_names %in% fcst))
  40.  
  41.  
  42. if (which(names(dataset1) %in% c("time"))>0) {
  43. time <- as.numeric(dataset1$time)
  44. }
  45. else {
  46. time <- seq(1:length(dataset1))
  47. }
  48. observed_data <- as.numeric(dataset1[,dataidx])
  49. forecast <- as.numeric(dataset1[,fcstidx])
  50. plot(time,observed_data,type="l",col="blue",xlab="Time",ylab="Data",lwd=1.5)
  51. lines(time,forecast,col="red",lwd=1.5)
  52. legend("topleft",legend = c("Original Data","Forecast"),bty=c("n","n"),lty=c(1,1),pch=16,col=c("blue","red"))
  53.  
  54. forecast_data_testwindow <- as.numeric(forecast[(which(!is.na(forecast)))])
  55. actual_data_testwindow <- as.numeric(observed_data[(which(!is.na(forecast)))])
  56. mase <- masefun(actual_data_testwindow,forecast_data_testwindow)
  57. smape <- smape(actual_data_testwindow,forecast_data_testwindow)
  58. arima_acc <- data.frame(Method=as.character(algo),accuracy(forecast_data_testwindow,actual_data_testwindow),MASE=mase,sMAPE=smape)
  59. arima_acc$Method <- as.character(arima_acc$Method)
  60. data.set <- arima_acc
  61.  
  62. lapply(data.set,class)
  63. return(data.set)
  64.  
  65. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement