{"cells":[{"cell_type":"markdown","metadata":{"_cell_guid":"bf1653b5-495c-9fd0-496e-5a96bc19bc8c"},"source":"I forked this to get 'horisontal' oriented net"},{"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                           x=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                           y=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 = -1 * nodeCoordinates$y\nnodeCoordinates$x = 3 * nodeCoordinates$x\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 = 0.5,\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}