nn_from_scratch.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "# Neural Network from Scratch\n",
    "### Written in R\n",
    "#### by Tim Dunbar"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Terms\n",
    "\n",
    "- Forward Propagation: The forward cycle that the inputs, initial weights, and bias makes through the network to make a prediction\n",
    "- Backward Propagation: The backward cycle used to learn the weights after the forward propagation “informs” the network how far off the predictions are (the loss).\n",
    "- Epoch: How many times we are going to go through the training data.\n",
    "- Weight: Multiplier for the x values that determine how much of their signal makes it to the next layer.\n",
    "- Bias: How easy it is to get a node to fire\n",
    "- Node: Smallest component of a layer, consists of two parts.\n",
    "- Layer: Comprised of multiple nodes\n",
    "- Regularization: Anything that helps a model generalize\n",
    "- Hyperparameters: As opposed to model parameters, e.g. weights. Not learnable through training the model.\n",
    "- Loss: The difference between the prediction the network makes for an observation and the ground truth for that same observation.\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Resources\n",
    "\n",
    "[Andrew Ng's Deep Learning Course](https://www.deeplearning.ai/)<br/>\n",
    "[University of Wisconsin](http://pages.cs.wisc.edu/~bolo/shipyard/neural/local.html)<br/>\n",
    "[The Math](http://parrt.cs.usfca.edu/doc/matrix-calculus/index.html)<br/>\n",
    "[Fast AI Course](http://course.fast.ai/)\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "<img src=\"images/network.jpg\">"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Purpose\n",
    "### To show exactly what is going on in a simple binary classification \"naive\" neural network. It will be naive because in the real world I would be worried about performance, here I am not. I am simply illustrating exactly how a neural network works with regards to the connections (and a bit of intuition regarding the mathematics).  I am not using any libraries so there is as little abstraction as possible.\n",
    "\n",
    "## Get data set\n",
    "### First thing's first, I need a data set. For \"training\" purposes only I am using the iris data set built into R. Since I am going to start with a simple binary classification the dataset will be formatted as such.\n",
    "\n",
    "## Why Neural Networks\n",
    "### Ultimately what we are dealing with is a very large linear function and our goal is to try and minimize loss."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 39,
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table>\n",
       "<thead><tr><th scope=col>df_y$`train[, 5]` == \"setosa\"</th></tr></thead>\n",
       "<tbody>\n",
       "\t<tr><td> TRUE</td></tr>\n",
       "\t<tr><td>FALSE</td></tr>\n",
       "\t<tr><td>FALSE</td></tr>\n",
       "\t<tr><td> TRUE</td></tr>\n",
       "\t<tr><td>FALSE</td></tr>\n",
       "\t<tr><td>FALSE</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "\\begin{tabular}{r|l}\n",
       " df\\_y\\$`train{[}, 5{]}` == \"setosa\"\\\\\n",
       "\\hline\n",
       "\t  TRUE\\\\\n",
       "\t FALSE\\\\\n",
       "\t FALSE\\\\\n",
       "\t  TRUE\\\\\n",
       "\t FALSE\\\\\n",
       "\t FALSE\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "df_y$`train[, 5]` == \"setosa\" | \n",
       "|---|---|---|---|---|---|\n",
       "|  TRUE | \n",
       "| FALSE | \n",
       "| FALSE | \n",
       "|  TRUE | \n",
       "| FALSE | \n",
       "| FALSE | \n",
       "\n",
       "\n"
      ],
      "text/plain": [
       "  df_y$`train[, 5]` == \"setosa\"\n",
       "1  TRUE                        \n",
       "2 FALSE                        \n",
       "3 FALSE                        \n",
       "4  TRUE                        \n",
       "5 FALSE                        \n",
       "6 FALSE                        "
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "data(\"iris\")\n",
    "\n",
    "iris_sub <- iris[ which(iris$Species == \"setosa\" | iris$Species == \"virginica\"), ]\n",
    "\n",
    "iris_sub <- iris_sub[sample(nrow(iris_sub)),]\n",
    "\n",
    "smp_size <- floor(0.75 * nrow(iris_sub))\n",
    "set.seed(123)\n",
    "train_ind <- sample(seq_len(nrow(iris_sub)), size = smp_size)\n",
    "\n",
    "train <- iris_sub[train_ind, ]\n",
    "test <- iris_sub[-train_ind, ]\n",
    "\n",
    "df_x  <- train[,(1:4)]\n",
    "\n",
    "df_y <- as.data.frame(train[,5])\n",
    "\n",
    "df_y_bool <- as.data.frame(df_y$`train[, 5]` == \"setosa\")\n",
    "head(df_y_bool)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Hyperparameters\n",
    "### I'm putting all of the hyperparameters here for ease of experimentation.  Technically bias is not a hyperparameter but for instructional purposes only it is here.\n",
    "\n",
    "### This is an ongoing project so there will be more here in the future."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 29,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "learning_rate <- 0.5\n",
    "epochs <- 9\n",
    "dropout_percent <- 0.5\n",
    "bias <- 0.05\n",
    "rand_init_size <- .002"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Random Initialization\n",
    "### To break symmetry we must initilize the weights randomly\n",
    "\n",
    "### If we set the initial weights to the same thing the same signal would go to each node in the subsequent layers."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 30,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "rand_init <- function(K) {\n",
    "  res <- data.frame(abs(rnorm(K)) * rand_init_size)\n",
    "  return(res)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Activation functions\n",
    "### These are some of the various activation functions (more on this later) we can use."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 31,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "sigmoid <- function (z) {\n",
    "  return(1 / (1 + exp(-1*z)))\n",
    "}\n",
    "\n",
    "relu <- function (z) {\n",
    "  return(max(0,z))\n",
    "}\n",
    "\n",
    "tanh <- function (z) {\n",
    "  return((exp(z) - exp(-1*z)) / (exp(z) + exp(-1*z)))\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Derivatives of activation functions\n",
    "### The derivatives of the activation functions are here for a similar reason. Note: These derivitives are used in the back propigation portion of a neural network and that is out of scope for this presentation, they are here only to provide context."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 8,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "sigmoid_deriv <- function(z) {\n",
    "  return(exp(z) / ((exp(z) + 1)^2))\n",
    "}\n",
    "\n",
    "relu_deriv <- function(z) {\n",
    "  if (z < 0) {\n",
    "    return(0)\n",
    "  } else {\n",
    "    return(1)\n",
    "  }\n",
    "}\n",
    "\n",
    "tanh_deriv <- function(z) {\n",
    "  return(4 * exp(2 * z) / (exp(4 * z) + 2 * exp(2 * z) + 1))\n",
    "}\n",
    "\n",
    "loss_deriv <- function(y_hat, y) {\n",
    "  return(y_hat - y)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "\n",
    "## Regularization functions\n",
    "### There are various regularization functions, dropout being only one of them. Again in the future there will be others."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 32,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "dropout <- function (layer_output) {\n",
    "  z <- rbinom(nrow(layer_output), 1, dropout_percent)\n",
    "  return(z * layer_output)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## The two parts of each node\n",
    "### Each node has two parts, they are seperate here (in the code) for illustrative purposes only."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "source": [
    "<img src=\"images/node.png\">"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 33,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "# IN: 1x1, 1x1, 1x1\n",
    "# OUT: 1x1\n",
    "node <- function (w, x) {\n",
    "  z <- w * x\n",
    "  # IN: 1x1\n",
    "  # OUT: 1x1\n",
    "  return(z)\n",
    "}\n",
    "\n",
    "# IN: 1x1\n",
    "# OUT: 1x1\n",
    "node_activation <- function(z, FUN){\n",
    "  y <- FUN(z)\n",
    "  return(y)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Layer of a NN\n",
    "### This is a layer of a neural network, here I've functionalized the parts of a layer, e.g. the layer itself and the node in the layer."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 34,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "# IN: 1x4, 1x1, 1x1\n",
    "# OUT: 1x1\n",
    "layer_node <- function (vals, FUN = sigmoid, weight_df, bias) {\n",
    "  res <- c()\n",
    "  for(i in 1:ncol(vals)) {\n",
    "    # IN: 1x1, 1x1, 1x1\n",
    "    # OUT: 1x1\n",
    "    res[i] <- node(weight_df, vals[,i])\n",
    "  }\n",
    "  \n",
    "  return(node_activation((sum(res) + bias), FUN))\n",
    "}\n",
    "\n",
    "# IN: 1x4, 5x1, 1x1\n",
    "# OUT: 5x1\n",
    "layer <- function (df, nodes, FUN = sigmoid, weight_df, bias) {\n",
    "  res <- matrix(ncol=1, nrow=nodes)\n",
    "  for(i in 1:nodes){\n",
    "    # IN: 1x4, 1x1, 1x1\n",
    "    # OUT: 1x1\n",
    "    res[i,] <- layer_node(df, FUN, weight_df[i,], bias)\n",
    "  }\n",
    "  return(data.frame(res))\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Loss and Cost\n",
    "### Every neural network must have loss and cost.  Remember loss is what we are trying to minimize."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 35,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "loss <- function(y_hat, y){\n",
    "  res <- 1 / 2 * (y_hat - y)^2\n",
    "  \n",
    "  return(res)\n",
    "}\n",
    "\n",
    "cost <- function(l){\n",
    "  l <- as.data.frame(l)\n",
    "  res <- 1 / nrow(l) * colSums(l)\n",
    "  return(res)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Update weights\n",
    "### Here we are going to update the weights based on the change and the learning rate"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 36,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "subslide"
    }
   },
   "outputs": [],
   "source": [
    "update <- function(weights, change, learn_rate) {\n",
    "  weights <- learn_rate*(weights - change)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Finally the Neural Network\n",
    "### This implementation uses all the variables and functions above."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 37,
   "metadata": {
    "collapsed": true,
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "outputs": [],
   "source": [
    "losses <- as.data.frame(matrix(ncol=5, nrow=nrow(df_x)))\n",
    "pred <- as.data.frame(matrix(ncol=5, nrow=nrow(df_x)))\n",
    "\n",
    "layer_0_weights <- rand_init(5)\n",
    "layer_1_weights <- rand_init(10)\n",
    "layer_2_weights <- rand_init(10)\n",
    "layer_3_weights <- rand_init(1)\n",
    "\n",
    "for (j in 1:epochs) {\n",
    "  for (i in 1:nrow(df_x)) {\n",
    "    # Forward Prop\n",
    "    \n",
    "    # IN: 1x4, 5x1, 1x1\n",
    "    # OUT: 5x1\n",
    "    layer_0 <- layer(df_x[i,], 5, sigmoid, layer_0_weights, bias)\n",
    "    # IN: 5x1\n",
    "    # OUT: 1x5\n",
    "    layer_0_t <- t(layer_0)\n",
    "    # IN: 1x5, 10x1, 1x1\n",
    "    # OUT: 10x1\n",
    "    layer_1 <- layer(layer_0_t, 10, tanh, layer_1_weights, bias)\n",
    "    # IN: 10x1\n",
    "    # OUT: 10x1\n",
    "    layer_1_reg <- dropout(layer_1)\n",
    "    # IN: 10x1\n",
    "    # OUT: 1x10\n",
    "    layer_1_reg_t <- t(layer_1_reg)\n",
    "    # IN: 1x1, 10x1, 1x1\n",
    "    # OUT: 10x1\n",
    "    layer_2 <- layer(layer_1_reg_t, 10, tanh, layer_2_weights, bias)\n",
    "    # IN: 10x1\n",
    "    # OUT: 10x1\n",
    "    layer_2_reg <- dropout(layer_2)\n",
    "    # IN: 10x1\n",
    "    # OUT: 1x10\n",
    "    layer_2_reg_t <- t(layer_2_reg)\n",
    "    # IN: 10x1, 1x1, 1x1\n",
    "    # OUT: 1x1\n",
    "    layer_3 <- layer(layer_2_reg_t, 1, relu, layer_3_weights, bias)\n",
    "    \n",
    "    L <- loss(layer_3, df_y_bool[i,])\n",
    "    \n",
    "    # Backward Prop (This doesn't work yet)\n",
    "    # l_b_prop <- loss_deriv(layer_3, df_y[i,])\n",
    "    # \n",
    "    # layer_3_b_prop <- layer(layer_2_reg_t, 1, sigmoid_deriv, layer_3_weights, bias)\n",
    "    # \n",
    "    # layer_2_b_prop <- layer(layer_1_reg_t, 10, tanh_deriv, layer_2_weights, bias)\n",
    "    # \n",
    "    # layer_1_b_prop <- layer(layer_0_t, 10, tanh_deriv, layer_1_weights, bias)\n",
    "    # \n",
    "    # layer_0_b_prop <- layer(df_x[i,], 5, sigmoid_deriv, layer_0_weights, bias)\n",
    "    \n",
    "    \n",
    "    losses[i,j] <- L\n",
    "    pred[i,j] <- layer_3\n",
    "  }\n",
    "\n",
    "  c <- cost(losses[,j])\n",
    "  \n",
    "  layer_0_weights <- update(layer_0_weights, c, learning_rate)\n",
    "  layer_1_weights <- update(layer_1_weights, c, learning_rate)\n",
    "  layer_2_weights <- update(layer_2_weights, c, learning_rate)\n",
    "  layer_3_weights <- update(layer_3_weights, c, learning_rate)\n",
    "}"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 40,
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "outputs": [
    {
     "data": {
      "text/html": [
       "<table>\n",
       "<thead><tr><th scope=col>pred</th><th scope=col>truth</th></tr></thead>\n",
       "<tbody>\n",
       "\t<tr><td> TRUE</td><td> TRUE</td></tr>\n",
       "\t<tr><td>FALSE</td><td>FALSE</td></tr>\n",
       "\t<tr><td> TRUE</td><td>FALSE</td></tr>\n",
       "\t<tr><td> TRUE</td><td> TRUE</td></tr>\n",
       "\t<tr><td>FALSE</td><td>FALSE</td></tr>\n",
       "\t<tr><td>FALSE</td><td>FALSE</td></tr>\n",
       "</tbody>\n",
       "</table>\n"
      ],
      "text/latex": [
       "\\begin{tabular}{r|ll}\n",
       " pred & truth\\\\\n",
       "\\hline\n",
       "\t  TRUE &  TRUE\\\\\n",
       "\t FALSE & FALSE\\\\\n",
       "\t  TRUE & FALSE\\\\\n",
       "\t  TRUE &  TRUE\\\\\n",
       "\t FALSE & FALSE\\\\\n",
       "\t FALSE & FALSE\\\\\n",
       "\\end{tabular}\n"
      ],
      "text/markdown": [
       "\n",
       "pred | truth | \n",
       "|---|---|---|---|---|---|\n",
       "|  TRUE |  TRUE | \n",
       "| FALSE | FALSE | \n",
       "|  TRUE | FALSE | \n",
       "|  TRUE |  TRUE | \n",
       "| FALSE | FALSE | \n",
       "| FALSE | FALSE | \n",
       "\n",
       "\n"
      ],
      "text/plain": [
       "  pred  truth\n",
       "1  TRUE  TRUE\n",
       "2 FALSE FALSE\n",
       "3  TRUE FALSE\n",
       "4  TRUE  TRUE\n",
       "5 FALSE FALSE\n",
       "6 FALSE FALSE"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "compare <- setNames(data.frame(as.data.frame(pred[,c(epochs)] == 0), df_y_bool), c(\"pred\", \"truth\"))\n",
    "head(compare)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "slideshow": {
     "slide_type": "slide"
    }
   },
   "source": [
    "## Follow on steps\n",
    "### These are the things that still need to be done:\n",
    "- Finish backprop\n",
    "- Add ability to save this all of this training a proper model\n",
    " + Last 2 layers of the network\n",
    " + Trained weights for those layers\n",
    " + Anciliary functions for connections\n",
    "- Proper scoring"
   ]
  }
 ],
 "metadata": {
  "celltoolbar": "Slideshow",
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "3.4.2"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 2
}