{"cells":[{"cell_type":"markdown","metadata":{"_cell_guid":"bf1653b5-495c-9fd0-496e-5a96bc19bc8c"},"source":"This is a visualization of the first 10,000 jobs. Node size indicates in-degree (how many jobs come into this station). Node colors indicate the Line. Alpha of paths indicates how often jobs go from this station to another. One can nicely see parallel station setups and overflow / backup lines."},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"ed6edb9e-22b5-9a8b-bb2a-1a31ccd733bd"},"outputs":[],"source":"options(warn=-1) #surpress warnings\n\n#imports for data wrangling\nlibrary(data.table)\nlibrary(dtplyr)\nlibrary(dplyr)\n\n#get the data - nrows set to 10000 to keep runtime manageable.\n#one expansion option would be to select a time frame to visualized\ndtNum <- fread(\"../input/train_numeric.csv\", select = c(\"Id\", \"Response\"),nrows = 10000)\ndtDate <- fread(\"../input/train_date.csv\", nrows = 10000)\n\n#for each job identify which stations are passed through and for those store the minimum time\nfor (station in paste0(\"S\",0:51))\n{\n  cols = min(which((grepl(station,colnames(dtDate)))))\n  if(!cols==Inf){\n    dtDate[,paste0(station) := dtDate[,cols,with = FALSE]]\n  }\n}\n\n#limit data to only when passed through station X\ndtStations = dtDate[,!grepl(\"L\",colnames(dtDate)),with=F]\n\n#melt data to go from wide to long format\ndtStationsM = melt(dtStations,id.vars=c(\"Id\"))\n\n#join with numeric to have Response\ndtStationsM %>%\n  left_join(dtNum, by = \"Id\") -> dtStationsM\n\n#remove NA entries - these are plentiful as after melting each station-job combination has its own row\ndtStationsM %>%\n  filter(!is.na(value)) -> dtStationsMFiltered\n\n#sort entries by ascending time\ndtStationsMFiltered %>%\n  arrange(value) -> dtStationsMFiltered\n\n#imports for plotting\nrequire(GGally)\nlibrary(network)\nlibrary(sna)\nlibrary(ggplot2)\n\n#plotting format\noptions(repr.plot.width=5, repr.plot.height=15)\n\n#for each row obtain the subsequent statoin\ndtStationsMFiltered %>%\n  group_by(Id) %>%\n  mutate(nextStation = lead(variable)) -> edgelistsComplete\n\n#for each id find the first node to be entered \nedgelistsComplete %>%\n  group_by(Id) %>%\n  filter(!(variable %in% nextStation)) %>%\n  ungroup() %>%\n  select(variable,Response) -> startingPoints\n\n#prior to each starting point insert an edge from a common origin\ncolnames(startingPoints) = c(\"nextStation\",\"Response\")\nstartingPoints$variable = \"S\"\nedgelistsComplete %>%\n  select(variable,nextStation,Response) -> paths\n\n#for each id find the row where there is no next station (last station to be visited)\n#fill this station with Response value\npaths[is.na(nextStation)]$nextStation = paste(\"Result\",paths[is.na(nextStation)]$Response)\n\n#combine data\npaths = rbind(startingPoints,paths)\npaths = select(paths,-Response)\npaths$nextStation = as.character(paths$nextStation)\npaths$variable = as.character(paths$variable)\n\n#rename columns for plotting\ncolnames(paths) <- c(\"Target\",\"Source\")\n\n#flip columns in a costly way because ggnet is a little dumb and I am lazy\npathshelp = select(paths,Source)\npathshelp$Target = paths$Target\npaths=pathshelp\n\n#create network from edgelist\nnet = network(as.data.frame(na.omit(paths)),\n              directed = TRUE)\n\n#create a station-line mapping lookup\nLineStations = NULL\nfor (station in unique(paths$Source)){\n  if(station!=\"S\")\n  {\n  x=paste0(\"_\",station,\"_\")\n  y=head(colnames(dtDate)[which(grepl(x,colnames(dtDate)))],1)\n  y=strsplit(y,\"_\")[[1]][1]\n  LineStations = rbind(LineStations,data.frame(Node=station,Line=y))\n  }\n}\nLineStations = rbind(LineStations,data.frame(Node=c(\"Result 1\",\"Result 0\",\"S\"),Line=c(\"Outcome\",\"Outcome\",\"START\")))\n\n#merge station-line mapping into graph for coloring purposes\nx = data.frame(Node = network.vertex.names(net))\nx = merge(x, LineStations, by = \"Node\", sort = FALSE)$Line\nnet %v% \"line\" = as.character(x)\n\n#setup station coordinates analogue to @JohnM\nnodeCoordinates=data.frame(label=c(\"S\",\"S0\",\"S1\",\"S2\",\"S3\",\"S4\",\"S5\",\"S6\",\n                                  \"S7\",\"S8\",\"S9\",\"S10\",\"S11\",\"S12\",\"S13\",\n                                  \"S14\",\"S15\",\"S16\",\"S17\",\"S18\",\"S19\",\n                                  \"S20\",\"S21\",\"S22\",\"S23\",\"S24\",\"S25\",\n                                  \"S26\",\"S27\",\"S28\",\"S29\",\"S30\",\"S31\",\n                                  \"S32\",\"S33\",\"S34\",\"S35\",\"S36\",\"S37\",\n                                  \"S38\",\"S39\",\"S40\",\"S41\",\"S43\",\n                                  \"S44\",\"S45\",\"S47\",\"S48\",\"S49\",\n                                  \"S50\",\"S51\",\"Result 0\",\"Result 1\"),\n                           y=c(0,\n                               1,2,3,3,4,4,5,5,6,7,7,7,\n                               1,2,3,3,4,4,5,5,6,7,7,7,\n                               6,6,7,7,7,\n                               8,9,10,10,10,11,11,12,13,14,\n                               8,9,10,11,11,12,13,14,15,15,16,\n                               17,17),\n                           x=c(5,\n                               9,9,10,8,10,8,10,8,7,10,9,8,\n                               5,5,6,4,6,4,6,4,5,6,5,4,\n                               2,0,2,1,0,\n                               7,7,8,7,6,8,6,7,7,7,\n                               3,3,3,4,2,3,3,3,4,2,3,\n                               7,3))\n\nnodeCoordinates$y = -3 * nodeCoordinates$y\n\n#setup initial plot\nnetwork = ggnet2(net)\n\n#grab node list from initial plot and attach coordinates\nnetCoordinates = select(network$data,label)\nnetCoordinates = left_join(netCoordinates,nodeCoordinates,by = \"label\")\nnetCoordinates = as.matrix(select(netCoordinates,x,y))\n\n#setup plot with manual layout\nnetwork = ggnet2(net,\n                 alpha = 0.75, size = \"indegree\",\n                 label = T, size.cut = 4,\n                 color = \"line\",palette = \"Set1\",\n                 mode = netCoordinates,\n                 edge.alpha = 0.5, edge.size = 1,\n                 legend.position = \"bottom\")\n\n\n#output plot on graphics device\nprint(network)"},{"cell_type":"markdown","metadata":{"_cell_guid":"23aab779-e965-5bca-ac14-b65bb343998d"},"source":"It may for other analyses potentially be interesting which paths are used a lot. And which ones are used very seldom? Also which ones lead to Response=1 or Response=0?"},{"cell_type":"code","execution_count":null,"metadata":{"_cell_guid":"30e71224-2287-5a2a-1bf7-486e4fc4b09f"},"outputs":[],"source":"#obtain summary statistic of number of edges on each station pair\npathshelp %>%\n    mutate(stationpair=paste0(Source,\"->\",Target)) %>%\n    group_by(stationpair) %>%\n    summarize(count=n()) %>%\n    arrange(-count) %>%\n    print(n=10)\n\npathshelp %>%\n    mutate(stationpair=paste0(Source,\"->\",Target)) %>%\n    group_by(stationpair) %>%\n    summarize(count=n()) %>%\n    arrange(count) %>%\n    print(n=10)\n\npathshelp %>%\n    filter(Target==\"Result 1\") %>%\n    mutate(stationpair=paste0(Source,\"->\",Target)) %>%\n    group_by(stationpair) %>%\n    summarize(count=n()) %>%\n    arrange(count) %>%\n    print(n=20)\n\npathshelp %>%\n    filter(Target==\"Result 0\") %>%\n    mutate(stationpair=paste0(Source,\"->\",Target)) %>%\n    group_by(stationpair) %>%\n    summarize(count=n()) %>%\n    arrange(count) %>%\n    print(n=20)"}],"metadata":{"_change_revision":0,"_is_fork":false,"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.3.1"}},"nbformat":4,"nbformat_minor":0}