Créer un graphe de site Web avec R

Dans cet article nous verrons comment créer un graphe de site Web avec R. Dans un article précédent nous avions vu comment créer un graphe de site Web « à la main » avec Gephi.

Cette méthode précédente avec Gephi, si elle permet de travailler finement sur un site, est toutefois chronophage. En effet vous devez à chaque fois utiliser un spider puis ensuite exporter et retraiter vos données avec Excel pour les rendre exploitables par Gephi.

L’idée est ici d’automatiser le processus, on fournit l’adresse d’un site au logiciel et il nous crée un graphe ! It’s magic !

Logiciel R

Afin de pouvoir tester le code source de cette démonstration nous vous invitons à télécharger Le Logiciel R sur ce site https://cran.r-project.org/, ainsi que l’environnement de développement RStudio ici : https://www.rstudio.com/products/rstudio/download/.

De quoi aurons-nous besoin ?

Comme nous l’indiquions précédemment nous aurons besoin d’un crawler de pages Web ainsi qu’un outil de visualisation de graphes de réseaux. Cela tombe bien, dans R nous avons repéré la bibliothèque Rcrawler qui propose un crawler de site et la bibliothèque igraph qui permet de gérer des graphes de réseaux. Toutefois le programme Rcrawler ne correspond pas tout à fait à ce que nous recherchions et nous avons du le réécrire en partie afin de s’approcher au plus près de ce que nous avions précédemment avec Screaming Frog SEO Spider. Au total nous avons du modifier 3 fonctions de Rcrawler :

• RobotParser : la fonction de lecture du fichier Robots.txt
• LinkNormalization : la fonction de création de liens normalisés (sous la forme http|https://wwwdomaine.com/…)
• Rcrawler : la fonction crawler elle même qui ne correspondait pas à nos besoins. Notamment elle ne renvoyait pas les code de redirections (301,302) que nous souhaitions. Par ailleurs on ne pouvait pas limiter le nombre de pages à parser.

Pour ne pas les confondre avec les fonctions originales nous leur avons adjoint un préfixe : « Network ». Dans notre cas elles se nommeront donc NetworkRobotParser, NetworkLinkNormalization et NetWorkRcrawler.

Code Source

Vous pouvez copier/coller les morceaux de codes source dans un script R pour les tester.

Vosu pouvez aussi récupérer tout le script gratuitement dans notre boutique : https://www.anakeyn.com/boutique/produit/script-r-creer-un-graphe-de-site-web/

Environnement

Environnement nécessaire à l’application à charger dans votre programme

#' 
#'
#Packages à installer une fois.
#install.packages("Rcrawler")
#install.packages("igraph")
#install.packages("foreach")
#install.packages("doParallel")
#install.packages("data.table")
#install.packages("gdata")
#install.packages("xml2")
#install.packages("httr")
#Bibliothèques à charger.
library(Rcrawler)  #Notamment pour Linkparamsfilter...
library(doParallel) #Notamment pour parallel::makeCluster	
library(data.table)  #Notamment pour %like% %in% ...
library(igraph) #Notamment graph.data.frame() ...
library(xml2) #Notamment pour read_html
library(httr)  #pour GET, content ...

NetworkRobotParser

NetworkRobotParser modifie le programme RobotParser de base de Rcrawler qui générait des erreurs. NetworkRobotParser est appelé par NetworkRcrawler.

#' NetworkRobotParser modifie RobotParser qui  générait une erreur d'encoding on rajoute MyEncod.
#' RobotParser fetch and parse robots.txt
#'
#' This function fetch and parse robots.txt file of the website which is specified in the first argument and return the list of correspending rules .
#' @param website character, url of the website which rules have to be extracted  .
#' @param useragent character, the useragent of the crawler
#' @return
#' return a list of three elements, the first is a character vector of Disallowed directories, the third is a Boolean value which is TRUE if the user agent of the crawler is blocked.
#' @import httr
#' @export
#'
#' @examples
#'
#' RobotParser("http://www.glofile.com","AgentX")
#' #Return robot.txt rules and check whether AgentX is blocked or not.
#'
#'
NetworkRobotParser <- function(website, useragent, Encod="UTF-8") {
  URLrobot<-paste(website,"/robots.txt", sep = "")
  bots<-GET(URLrobot, user_agent("Mozilla/5.0 (Windows NT 6.3; WOW64; rv:42.0) Gecko/20100101 Firefox/42.0"),timeout(5))
  #PR Ajout de Encod
  MyEncod <- trimws(gsub("charset=", "", unlist(strsplit(bots$headers$'content-type', ";"))[2]))
  if (is.null(MyEncod) || is.na(MyEncod) ) MyEncod <- Encod
  bots<-as.character(content(bots, as="text", encoding = MyEncod))  #pour éviter erreur d encoding
  write(bots, file = "robots.txt")
  bots <- readLines("robots.txt") # dans le repertoire du site
  if (missing(useragent)) useragent<-"NetworkRcrawler"
  useragent <- c(useragent, "*")
  ua_positions <- which(grepl( "[Uu]ser-[Aa]gent:[ ].+", bots))
  Disallow_dir<-vector()
  allow_dir<-vector()
  for (i in 1:length(useragent)){
    if (useragent[i] == "*") useragent[i]<-"\\*"
    Gua_pos <- which(grepl(paste("[Uu]ser-[Aa]gent:[ ]{0,}", useragent[i], "$", sep=""),bots))
    if (length(Gua_pos)!=0 ){
      Gua_rules_start <- Gua_pos+1
      Gua_rules_end <- ua_positions[which(ua_positions==Gua_pos)+1]-1
      if(is.na(Gua_rules_end)) Gua_rules_end<- length(bots)
      Gua_rules <- bots[Gua_rules_start:Gua_rules_end]
      Disallow_rules<-Gua_rules[grep("[Dd]isallow",Gua_rules)]
      Disallow_dir<-c(Disallow_dir,gsub(".*\\:.","",Disallow_rules))
      allow_rules<-Gua_rules[grep("^[Aa]llow",Gua_rules)]
      allow_dir<-c(allow_dir,gsub(".*\\:.","",allow_rules))
    }
  }
  if ("/" %in% Disallow_dir){
    Blocked=TRUE
    print ("This bot is blocked from the site")} else{ Blocked=FALSE }
  
  Rules<-list(Allow=allow_dir,Disallow=Disallow_dir,Blocked=Blocked )
  return (Rules)
}

NetworkLinkNormalization

NetworkLinkNormalization modifie le programme original LinkNormalization. Notamment le programme ne dédoublonne pas les liens. En effet nous avons considéré que ce dédoublonnement était un choix qui devait être fait au niveau du traitement du graphe et non pas au niveau de la collecte des liens. Par ailleurs, nous avons corrigé quelque bugs.
NetworkLinkNormalization est appelé par NetworkRcrawler.

#' 
#'
#' NetworkLinkNormalization :modification de LinkNormalization : 
#' on ne renvoie pas des liens uniques mais multiples : le dédoublonnement des liens doit se faire lors de 
#' l'étude du  réseau avec igraph.
#' correction aussi pour les liens avec # et mailto:, callto: et tel: qui étaient renvoyés.
#'
#' A function that take a URL _charachter_ as input, and transforms it into a canonical form.
#' @param links character, the URL to Normalize.
#' @param current character, The URL of the current page source of the link.
#' @return
#' return the simhash as a nmeric value
#' @author salim khalilc corrigé par Pierre Rouarch
#' @details
#' This funcion call an external java class  
#' @export
#'
#' @examples
#'
#' # Normalize a set of links
#'
#' links<-c("http://www.twitter.com/share?url=http://glofile.com/page.html",
#'          "/finance/banks/page-2017.html",
#'          "./section/subscription.php",
#'          "//section/",
#'          "www.glofile.com/home/",
#'          "glofile.com/sport/foot/page.html",
#'          "sub.glofile.com/index.php",
#'          "http://glofile.com/page.html#1"
#'                    )
#'
#' links<-LinkNormalization(links,"http://glofile.com" )
#'
#'
NetworkLinkNormalization<-function(links, current){
  protocole<-strsplit(current, "/")[[c(1,1)]]
  base <- strsplit(gsub("http://|https://", "", current), "/")[[c(1, 1)]]
  base2 <- strsplit(gsub("http://|https://|www\\.", "", current), "/")[[c(1, 1)]]
  rlinks<-c();
  #base <- paste(base, "/", sep="")
  
  for(t in 1:length(links)){
    if (!is.null(links[t]) && length(links[t]) == 1){  #s'il y a qq chose
      if (!is.na(links[t])){ #pas NA
       if(substr(links[t],1,2)!="//"){ #si ne commence pas par //
          if(sum(gregexpr("http", links[t], fixed=TRUE)[[1]] > 0)<2) {  #Si un seul http
            # remove spaces
            if(grepl("^\\s|\\s+$",links[t])) { 
              links[t]<-gsub("^\\s|\\s+$", "", links[t] , perl=TRUE)
            }
            #if starts with # remplace par url courante
            if (substr(links[t],1,1)=="#"){
              links[t]<- current }   #on est sut la même page (PR)
            #if starts with / add base 
            if (substr(links[t],1,1)=="/"){
              links[t]<-paste0(protocole,"//",base,links[t]) }
            #if starts with ./ add base
            if (substr(links[t],1,2)=="./") {
              # la url current se termine par /
              if(substring(current, nchar(current)) == "/"){
                links[t]<-paste0(current,gsub("\\./", "",links[t]))
                # si non
              } else {
                links[t]<-paste0(current,gsub("\\./", "/",links[t]))
              }
            }
            
            if(substr(current,1,10)=="http://www" || substr(current,1,11)=="https://www") {  #si on a un protocole + www  sur la page courante.
              if(substr(links[t],1,10)!="http://www" && substr(links[t],1,11)!="https://www" && substr(links[t],1,8)!="https://" && substr(links[t],1,7)!="http://" ){
                if (substr(links[t],1,3)=="www") {
                  links[t]<-paste0(protocole,"//",links[t])
                } else {
                  #tests liens particulier sans protocole http://
                  if(substr(links[t],1,7)!="mailto:" && substr(links[t],1,7)!="callto:" && substr(links[t],1,4)!="tel:") {  
                  links[t]<-paste0(protocole,"//www.",links[t])
                  }
                  
                }
              }
            }else {   #à priori pas de http sans www dans current
              if(substr(links[t],1,7)!="http://" && substr(links[t],1,8)!="https://" ){
                #test liens cas particuliers sans protocole http://
                if(substr(links[t],1,7)!="mailto:" && substr(links[t],1,7)!="callto:" && substr(links[t],1,4)!="tel:") {  
                  links[t]<-paste0(protocole,"//",links[t])
                }
               }
            }
            if(grepl("#",links[t])){links[t]<-gsub("\\#(.*)","",links[t])}  #on vire ce qu'il y a derrière le #
            
            rlinks <- c(rlinks,links[t])  #ajout du lien au paquet de liens
          }
        }
      }
    }
  }
  #rlinks<-unique(rlinks)  #NON : garder tous les liens,  pas d'unicité.
  return (rlinks)
}

NetworkRcrawler

NetworkRcrawler modifie substantiellement le programme Rcrawler. Notamment pour la lecture des Urls nous avons utilisé directement la fonction GET() du package httr et non pas la fonction spécifique LinkExtractor utilisée par la version de base. GET() permet de récupérer plus d’infos sur les headers. Les extractions de contenus ont été supprimés car il ne nous semblait pas que ce soit à ce stade que l’on devait traiter ce sujet. Le contenu des pages est passé via la data.frame NetwNodes dans la variable HTMLContent. Le programme passe les informations de liens et de noeuds au travers des data.frames NetwEdges et NetwNodes.

#' NetworkRcrawler  (modification de Rcrawler par Pierre Rouarch pour limiter le nombre de page crawlées et éviter
#' une attente trop longue) :
#' NetworkRcrawler a pour objectif de créer un réseau de pages de site exploitable par iGraph
#' 
#' Version 1.0
#' 
#' #' Modification vs Rcrawler :
#' Ajout du paramètre MaxPagesParsed   pour limiter les pages "parsées" et y passer la nuit
#' Ajout du Paramètres IndexErrPages  pour récupérér des pages avec status autre que 200
#' On utilise GET() plutôt que LinkExtractor car LinkExtractor ne nous renvoyait pas les  infos voulues 
#' notamment les redirections.
#' Récupération du contenu de la page dans pkg.env$GraphNodes plutôt que passer par des fichiers externes
#' La valeur de pkg.env$GraphEdges$Weight est à 1 et non pas à la valeur du level de la page comme précédemment.
#' 
#' 
#' Simplification vs Rcrawler : 
#' Suppression de l'enregistrement des fichiers *.html pour gagner en performance
#' Nous avons aussi supprimer les paramètres d'extraction qui ne nous semblent pas pertinents à ce 
#' stade : Comme le contenu est passé à travers de NetwNodes$Content les extractions de contenus 
#' peuvent(doivent?) se faire en dehors de la construction du Réseau de pages à proprement parlé.
#' 
#' Paramètres conservés vs Rcrawler
#' @param Website character, the root URL of the website to crawl and scrape.
#' @param no_cores integer, specify the number of clusters (logical cpu) for parallel crawling, by default it's the numbers of available cores.
#' @param no_conn integer, it's the number of concurrent connections per one core, by default it takes the same value of no_cores.
#' @param MaxDepth integer, repsents the max deph level for the crawler, this is not the file depth in a directory structure, but 1+ number of links between this document and root document, default to 10.
#' @param RequestsDelay integer, The time interval between each round of parallel http requests, in seconds used to avoid overload the website server. default to 0.
#' @param Obeyrobots boolean, if TRUE, the crawler will parse the website\'s robots.txt file and obey its rules allowed and disallowed directories.
#' @param Useragent character, the User-Agent HTTP header that is supplied with any HTTP requests made by this function.it is important to simulate different browser's user-agent to continue crawling without getting banned.
#' @param Encod character, set the website caharacter encoding, by default the crawler will automatically detect the website defined character encoding.
#' @param Timeout integer, the maximum request time, the number of seconds to wait for a response until giving up, in order to prevent wasting time waiting for responses from slow servers or huge pages, default to 5 sec.
#' @param URLlenlimit integer, the maximum URL length limit to crawl, to avoid spider traps; default to 255.
#' @param urlExtfilter character's vector, by default the crawler avoid irrelevant files for data scraping such us xml,js,css,pdf,zip ...etc, it's not recommanded to change the default value until you can provide all the list of filetypes to be escaped.
#' @param ignoreUrlParams character's vector, the list of Url paremeter to be ignored during crawling .
#' @param NetwExtLinks boolean, If TRUE external hyperlinks (outlinks) also will be counted on Network edges and nodes.
#' Paramètre  ajouté 
#' @param MaxPagesParsed integer,  Maximum de pages à Parser  (Ajout PR)
#' 
#' 
#' 
#' @return
#'
#' The crawling and scraping process may take a long time to finish, therefore, to avoid data loss 
#' in the case that a function crashes or stopped in the middle of action, some important data are 
#' exported at every iteration to R global environment:
#'
#' - NetwNodes : Dataframe with alls hyperlinks and parameters of pages founded. 
#' - NetwEdges : data.frame representing edges of the network, with these column : From, To, Weight (1) and Type (1 for internal hyperlinks 2 for external hyperlinks).
#'
#' @details
#'
#' To start NetworkRcrawler (or Rcrawler) task you need the provide the root URL of the website you want to scrape, it can 
#' be a domain, a subdomain or a website section (eg. http://www.domain.com, http://sub.domain.com or 
#' http://www.domain.com/section/). The crawler then will go through all its internal links. 
#' The process of a crawling is performed by several concurrent processes or nodes in parallel, 
#' So, It is recommended to use R 64-bit version.
#'
#' For more tutorials about RCrawler check https://github.com/salimk/Rcrawler/
#'
#' For scraping complexe character content such as arabic execute Sys.setlocale("LC_CTYPE","Arabic_Saudi Arabia.1256") then set the encoding of the web page in Rcrawler function.
#'
#' If you want to learn more about web scraper/crawler architecture, functional properties and implementation using R language, Follow this link and download the published paper for free .
#'
#' Link: http://www.sciencedirect.com/science/article/pii/S2352711017300110
#'
#' Dont forget to cite Rcrawler paper:
#' Khalil, S., & Fakir, M. (2017). RCrawler: An R package for parallel web crawling and scraping. SoftwareX, 6, 98-106.
#'
#' @examples
#'
#' \dontrun{
#'  NetworkRcrawler(Website ="http://www.example.com/", no_cores = 4, no_conn = 4)
#'  #Crawl, index, and store web pages using 4 cores and 4 parallel requests

#'  NetworkRcrawler(Website = "http://www.example.com/", no_cores=8, no_conn=8, Obeyrobots = TRUE,
#'   Useragent="Mozilla 3.11")
#'   # Crawl and index the website using 8 cores and 8 parallel requests with respect to
#'   # robot.txt rules.
#'
#'   NetworkRcrawler(Website = "http://www.example.com/" , no_cores = 4, no_conn = 4, MaxPagesParsed=50)
#'   # Crawl the website using 4 cores and 4 parallel requests until the number of parsed pages reach 50
#'
#'   # Using Igraph for exmaple you can plot the network by the following commands
#'    library(igraph)
#'    network<-graph.data.frame(NetwEdges, directed=T)
#'    plot(network)
#'}
#'
#'
#' @author salim khalil modifié simplifié par Pierre Rouarch
#' @import foreach doParallel parallel data.table selectr
#' @export
#' @importFrom utils write.table
#' @importFrom utils flush.console
#'


NetworkRcrawler <- function(Website, no_cores, no_conn, MaxDepth = 10, RequestsDelay=0, Obeyrobots=FALSE,
                     Useragent, Encod, Timeout=5, URLlenlimit=255, urlExtfilter,
                     ignoreUrlParams = "", ManyPerPattern=FALSE,  NetwExtLinks=FALSE,
                      MaxPagesParsed=500 ) {
  


  if (missing(no_cores)) no_cores<-parallel::detectCores()-1
  if (missing(no_conn)) no_conn<-no_cores
  if(missing(Useragent)) {Useragent="Mozilla/5.0 (Windows NT 6.3; WOW64; rv:42.0) Gecko/20100101 Firefox/42.0"}

  # Récupération encoding de la page d accueil du site
  if(missing(Encod)) {
  Encod<- Getencoding(Website)
  if (length(Encod)!=0){
   if(Encod=="NULL") Encod="UTF-8" ;
   } #/ if (length(Encod)!=0)
  } #/ if(missing(Encod))


  
  #Filtrer les documents/fichiers  non souhaités
  if(missing(urlExtfilter)) { 
    urlExtfilter<-c("flv","mov","swf","txt","xml","js","css","zip","gz","rar","7z","tgz","tar","z","gzip","bzip","tar","mp3","mp4","aac","wav","au","wmv","avi","mpg","mpeg","pdf","doc","docx","xls","xlsx","ppt","pptx","jpg","jpeg","png","gif","psd","ico","bmp","odt","ods","odp","odb","odg","odf") 
    } #/if(missing(urlExtfilter))


  #Récupération du nom de domaine seul 
  domain<-strsplit(gsub("http://|https://|www\\.", "", Website), "/")[[c(1, 1)]]
  
  #Lecture de Robot.txt
  if (Obeyrobots) {
    rules<-NetworkRobotParser(Website,Useragent, Encod = Encod)
    urlbotfiler<-rules[[2]]
    urlbotfiler<-gsub("^\\/", paste("http://www.",domain,"/", sep = ""), urlbotfiler , perl=TRUE)
    urlbotfiler<-gsub("\\*", ".*", urlbotfiler , perl=TRUE)
  } else {urlbotfiler=" "}
  

 

  pkg.env <- new.env()  #créé un nouvel environnement pour données locales
  #Création des variables pour la  data.frame des noeuds/pages pkg.env$GraphNodes
  Id<-vector() #Id de page 
  MyUrl<-vector() #Url de la page crawlé
  MyStatusPage<-vector() #Status de la page dans la boucle : discovered, crawled, parsed.
  Level <- numeric()  #Niveau de la page dans le site/réseau
  NbIntLinks <-numeric() #Nbre de liens internes sur la page si parsée
  NbExtLinks <-numeric() #Nbre de liens Externes sur la page si parsée
  HttpStat<-vector() #Statut http : 200, 404
  IntermediateHttpStat<-vector() #Statut http "intermédiaire" pour récupérer les redirections (301, 302)
  ContentType<-vector() #Type de contenu ie : text/html ...
  Encoding<-vector() #Encoding ie : UTF-8
  PageType<-vector()    #Type de page 1 interne, 2 externe sert aussi dans pkg.env$GraphEgdes
  HTMLContent <- vector() #Ajouté par PR -> Contenu html de la page 
  #PR ajout pkg.env$GraphNodes (contient les pages parsées, crawlées et non crawlées, internes et externes)
  pkg.env$GraphNodes<-data.frame(Id, MyUrl, MyStatusPage, Level, NbIntLinks, NbExtLinks, HttpStat, IntermediateHttpStat, ContentType, Encoding, PageType, HTMLContent)
  names(pkg.env$GraphNodes) <- c("Id","Url","MyStatusPage","Level","NbIntLinks", "NbExtLinks", "HttpStat", "IntermediateHttpStat", "ContentType","Encoding", "PageType", "HTMLContent")

  #Création des variables pour la  data.frame des liens pkg.env$GraphEdges
  FromNode<-vector()  #Id de la page de départ
  ToNode<-vector() #Id de la page d'arrivée
  Weight<-vector()  #Poids du lien  ici on prendra = 1 
  pkg.env$GraphEgdes<-data.frame(FromNode,ToNode,Weight,PageType)  #Data.frame des noeuds. le poids du liens est le niveau de page d'arrivée, le Type interne externe. 
  names(pkg.env$GraphEgdes) <- c("From","To","Weight","PageType") #Noms des variables de la data.frame.
  
  #Autres variables intermédiaires utiles.
  allpaquet<-list() #Contient les paquets de pages crawlées parsées.
  Links<-vector() #Liste des liens sur la page 



  #initialisation des noeuds/pages.
  pkg.env$GraphNodes[1,"Id"] <- 1   #initialisation Id 1ere page
  pkg.env$GraphNodes[1,"Url"] <- Website #initialisation Url fournie par nous.
  pkg.env$GraphNodes[1, "MyStatusPage"] <- "discovered"
  pkg.env$GraphNodes[1,"Level"]  <- 0  #initialisation (niveau de première page à 0)
  pkg.env$GraphNodes[1,"PageType"]  <- 1 #Page Interne.
  pkg.env$GraphNodes[1,"Encoding"]  <- Encod #Récupéré par GetEncoding ou forcé à UTF-8
  
  #On force IndexErrPages pour récupérer les errreurs http
  IndexErrPages<-c(200, 300, 301, 302, 404, 403, 500, 501, 502, 503, NULL, NA, "")

  
  lev<-0   #Niveau du site à 0 (première page)
  LevelOut <- 0  #Niveau des pages du site atteint en retour de Get - mis à 0 pour pouvoir démarrer
  t<-1     #index de début de paquet de pages à parser (pour GET)
  i<-0     #index de pages parsées pour GET
  TotalPagesParsed <- 1  #Nombre total de pages parsées.

  
  
  #cluster initialisation pour pouvoir travailler sur plusieurs clusters en même temps .
  cl <- makeCluster(no_cores, outfile="") #création des clusters nombre no_cores fourni par nos soins.
  registerDoParallel(cl)
  clusterEvalQ(cl, library(httr))   #Pour la fonction GET


  
  
  
  ############################################################################################  
  #  Utilistation de GET() plutot que LinkExtractor :
  ############################################################################################  



  #Tant qu'il reste des pages à crawler  :
  while (t<=nrow(pkg.env$GraphNodes)) {

        
    # Calcul du nombre de pages à crawler !
    rest<-nrow(pkg.env$GraphNodes)-t  #Rest = nombre de pages restantes à crawler = nombre de pages - pointeur actuel de début de paquet 
    #Si le nombre de connections simultanées est inférieur au nombre de pages restantes à crawler.
    if (no_conn<=rest){  
      l<-t+no_conn-1    #la limite du prochain paquet de pages à crawler = pointeur actuel + nombre de connections - 1
    } else {
      l<-t+rest  #Sinon la limite = pointeur + reste 
    }
    

    
    #Délai
    if (RequestsDelay!=0) {
      Sys.sleep(RequestsDelay)
    }
    #Extraction d'un paquet de pages de t pointeur actuel à l limite 
    allGetResponse <- foreach(i=t:l,  .verbose=FALSE, .inorder=FALSE, .errorhandling='pass')  %dopar%
    {
      TheUrl <- pkg.env$GraphNodes[i,"Url"] #url de la page à crawler.
      GET(url = TheUrl, timeout = Timeout )
    } #/ foreach  
    
    #On regarde ce que l'on a récupéré de GET 
    for (s in 1:length(allGetResponse)) {
      TheUrl <- pkg.env$GraphNodes[t+s-1,"Url"] #t+s-1 pointeur courant dans GrapNodes

      if (!is.null(allGetResponse[[s]])) {  #Est-ce que l'on a une réponse pour cette  page ? 
        
        if (!is.null(allGetResponse[[s]]$status_code)) { #Est-ce que l'on a un status pour cette page ?
        
        #Recupération des données de la page crawlée et/ou parsée.
        #Si on n'avait pas déjà HttpStat
        if (is.null(pkg.env$GraphNodes[t+s-1, "HttpStat"]) || is.na(pkg.env$GraphNodes[t+s-1, "HttpStat"])) {
          if (!is.null(allGetResponse[[s]]$status_code) ) 
              pkg.env$GraphNodes[t+s-1, "HttpStat"] <- allGetResponse[[s]]$status_code
          }  #/if (is.null(pkg.env$GraphNodes[t+s-1, "HttpStat"]) || is.na(pkg.env$GraphNodes[t+s-1, "HttpStat"]))
        #pour les status de redirections.
        if (!is.null(allGetResponse[[s]]$all_headers[[1]]$status))  pkg.env$GraphNodes[t+s-1, "IntermediateHttpStat"] <- allGetResponse[[s]]$all_headers[[1]]$status
        # Si on n'avait pas déjà ContentType
        if (is.null(pkg.env$GraphNodes[t+s-1, "ContentType"]) || is.na(pkg.env$GraphNodes[t+s-1, "ContentType"])) 
         { pkg.env$GraphNodes[t+s-1, "ContentType"] <- trimws(unlist(strsplit(allGetResponse[[s]]$headers$'content-type', ";"))[1]) }
        # Si on n'avait pas déjà Encoding
        if (is.null(pkg.env$GraphNodes[t+s-1, "Encoding"]) || is.na(pkg.env$GraphNodes[t+s-1, "Encoding"])) 
         { pkg.env$GraphNodes[t+s-1, "Encoding"] <- trimws(gsub("charset=", "", unlist(strsplit(allGetResponse[[s]]$headers$'content-type', ";"))[2])) }

        #On récupère tout le contenu HTML
        MyEncod <- pkg.env$GraphNodes[t+s-1, "Encoding"]  #Verifie que l'on a un encoding auparavent
        if (is.null(MyEncod) || is.na(MyEncod) )  MyEncod <- Encod 
        
        pkg.env$GraphNodes[t+s-1, "HTMLContent"] <- content(allGetResponse[[s]], "text", encoding=MyEncod) #Récupere contenu HTML
        #Marque la page comme "crawlée"
        pkg.env$GraphNodes[t+s-1, "MyStatusPage"]  <- "crawled"
        #Niveau de cette page dans le réseau.
        LevelOut <- pkg.env$GraphNodes[t+s-1, "Level"]   #Level de la page crawlée
 
        
        #Parsing !!! Ici rechercher les liens  si c'est autorisé et page interne.
        if (MaxDepth>=LevelOut && TotalPagesParsed <= MaxPagesParsed &&  pkg.env$GraphNodes[t+s-1, "PageType"]==1) { #Récupérer des liens

          pkg.env$GraphNodes[t+s-1, "MyStatusPage"]  <- "parsed"
          TotalPagesParsed <- TotalPagesParsed + 1 #Total des pages parsées (pour la prochaine itération)
          
          x <- read_html(x = content(allGetResponse[[s]], "text"))  #objet html
          links<-xml2::xml_find_all(x, "//a/@href")  #trouver les liens 
          links<-as.vector(paste(links))   #Vectorisation des liens 
          links<-gsub(" href=\"(.*)\"", "\\1", links)  #on vire href
          

          #Va récupérer les liens normalisés.
          links<-NetworkLinkNormalization(links,TheUrl) #revient avec les protocoles http/https sauf liens mailto etc.
           #on ne conserve que les liens avec http
          links<-links[links %like% "http" ]
          # Ignore Url parameters
          links<-sapply(links , function(x) Linkparamsfilter(x, ignoreUrlParams), USE.NAMES = FALSE)
          # Link robots.txt filter
          if (!missing(urlbotfiler)) links<-links[!links %like% paste(urlbotfiler,collapse="|") ]

          #Récupération des liens internes et des liens externes 
          IntLinks <- vector()  #Vecteur des liens internes
          ExtLinks <- vector() #Vecteur des liens externes.
          
          if(length(links)!=0) {
            for(iLinks in 1:length(links)){
              if (!is.na(links[iLinks])){
                #limit length URL to 255
                if( nchar(links[iLinks])<=URLlenlimit) {
                  ext<-tools::file_ext(sub("\\?.+", "", basename(links[iLinks])))
                  #Filtre eliminer les liens externes , le lien source lui meme, les lien avec diese , 
                  #les types de fichier filtrer, les lien tres longs , les liens de type share
                  #if(grepl(domain,links[iLinks]) && !(links[iLinks] %in% IntLinks) && !(ext %in% urlExtfilter)){
                  #Finalement on garde les liens déjà dans dans la liste 
                  #(c'est à iGraph de voir si on souhaite simplifier le graphe)

                  if(grepl(domain,links[iLinks]) && !(ext %in% urlExtfilter)){  #on n'enlève que les liens hors domaine et à filtrer.
                    #C'est un lien interne
                    IntLinks<-c(IntLinks,links[iLinks])
 
                  } #/if(!(ext %in% urlExtfilter))
                  if(NetwExtLinks){ #/si je veux les liens externes en plus (les doublons seront gérés par iGraph)
                
                    #if ( !grepl(domain,links[iLinks]) && !(links[iLinks] %in% ExtLinks) && !(ext %in% urlExtfilter)){
                    if ( !grepl(domain,links[iLinks])  && !(ext %in% urlExtfilter)){
                      ExtLinks<-c(ExtLinks,links[iLinks])
                      }  #/if ( !grepl(domain,links[iLinks]) && !(links[iLinks] %in% ExtLinks) && !(ext %in% urlExtfilter))
                    } #if(ExternalLInks)
                    
                  } # / if( nchar(links[iLinks])<=URLlenlimit) 
                } #/if (!is.na(links[iLinks]))
              } #/for(iLinks in 1:length(links))
            } #/if(length(links)!=0) 
          
           #Sauvegarde du  nombre de liens internes  sur la page parsée
          pkg.env$GraphNodes[t+s-1, "NbIntLinks"]  <- length(IntLinks)
          #Sauvegarde du  nombnre de liens externes  sur la page parsée
          pkg.env$GraphNodes[t+s-1, "NbExtLinks"]  <- length(ExtLinks)          
          
            #Sauvegarde des liens internes dans GraphNodes et GraphEdges :
            
            for(NodeElm in IntLinks) { #Sauvegarde des nouveaux noeuds dans GraphNodes et des liens dans GraphEdges
 
              #Ajout dans le graphe des Nodes des nouvelles pages internes découvertes 
              if (! (NodeElm  %in% pkg.env$GraphNodes[, "Url"] )) {
                NewIndexNodes <- nrow(pkg.env$GraphNodes) + 1
                pkg.env$GraphNodes[NewIndexNodes, "Id"] <- NewIndexNodes
                pkg.env$GraphNodes[NewIndexNodes, "Url"] <- NodeElm  #Récupération de l'URL.
                pkg.env$GraphNodes[NewIndexNodes, "MyStatusPage"] <- "discovered"  #Nouvelle page interne découverte.
                pkg.env$GraphNodes[NewIndexNodes, "Level"] <- LevelOut+1  #Niveau de la page parsée + 1 
                pkg.env$GraphNodes[NewIndexNodes, "PageType"] <- 1 #Page Interne
                
              } #/ if (! (NodeElm  %in% pkg.env$GraphNodes[, "Url"] ))
              
              
              #Sauvegarde des liens.
              #position de la page de départ 
              posNodeFrom<-t+s-1 
              #position de la page d arrivée
              posNodeTo <- chmatch(NodeElm, pkg.env$GraphNodes[,"Url"])   
              #Insertion dans la data.frame des liens #type de lien 1 interne - Weight <- 1 (avant:  LevelOut +1)
              pkg.env$GraphEgdes[nrow(pkg.env$GraphEgdes) + 1,]<-c(posNodeFrom,posNodeTo,1,1)
              
            } #/for(NodeElm in IntLinks)
            

         #Insertion des liens externes dans GraphNodes et GraphEdges.
            
            for(NodeElm in ExtLinks){
               #Ajout dans le graphe des Nodes des nouvelles pages externes repérées 
              if (! (NodeElm  %in% pkg.env$GraphNodes[, "Url"] )) {  #Si n'existe pas insérer
                NewIndexNodes <- nrow(pkg.env$GraphNodes) + 1
                pkg.env$GraphNodes[NewIndexNodes, "Id"] <- NewIndexNodes
                pkg.env$GraphNodes[NewIndexNodes, "Url"] <- NodeElm
                pkg.env$GraphNodes[NewIndexNodes, "MyStatusPage"] <- "discovered"  #Nouvelle page externe découverte.
                pkg.env$GraphNodes[NewIndexNodes, "Level"] <- LevelOut+1  #Niveau de la page parsée + 1 
                pkg.env$GraphNodes[NewIndexNodes, "PageType"] <- "2" #Page Externe
              } #/if (! (NodeElm  %in% pkg.env$GraphNodes[, "Url"] ))
              
              #Sauvegarde des liens.
              #position de la page de départ 
              posNodeFrom<-t+s-1 
              #position de la page d arrivée
              posNodeTo <- chmatch(NodeElm, pkg.env$GraphNodes[,"Url"])  #
              #Insertion dans la data.frame des liens #type de lien 2 externe, Weight <- 1 
              pkg.env$GraphEgdes[nrow(pkg.env$GraphEgdes) + 1,]<-c(posNodeFrom,posNodeTo,1,2)  
              
              
              
              
            }  #/for(NodeElm in ExtLinks)
            
            
            
          
          } #/if (MaxDepth>=LevelOut && TotalPagesParsed <= MaxPagesParsed &&  pkg.env$GraphNodes[t+s-1, "PageType"]==1)
        
        }   #/if (is.null(allGetResponse[[s]]$status_code)) 
        
        
        } #/if (!is.null(allGetResponse[[s]]))
       
    } #/for (s in 1:length(allGetResponse))
    
    cat("Crawl with GET  :",format(round((t/nrow(pkg.env$GraphNodes)*100), 2),nsmall = 2),"%  : ",t,"to",l,"crawled from ",nrow(pkg.env$GraphNodes)," Parsed:", TotalPagesParsed-1, "\n")
    
    t<-l+1  #Paquet suivant 
    
    #Sauvegarde des données vers l'environnement global.
    
    assign("NetwEdges", pkg.env$GraphEgdes, envir = as.environment(1) )  #Renvoie les données Edges vers env global
    assign("NetwNodes", pkg.env$GraphNodes, envir = as.environment(1) )  #Idem Nodes
    
  } #/while (t<=nrow(pkg.env$graphNodes)
  
  

 
  
  
  
  #Arret des clusters.

  stopCluster(cl)
  stopImplicitCluster()
  rm(cl)

    cat("+ Network nodes plus parameters are stored in a variable named : NetwNodes \n")
    cat("+ Network edges are stored in a variable named : NetwEdges \n")
 
  
} #/NetworkRcrawler

  

########################################################################################

Appel de NetworkRcrawler

Voilà nous pouvons maintenant faire appel à la fonction NetworkRcrawler. Profitons en pour tester notre site https://www.anakeyn.com. Nous limitons le nombre de pages à parser à 500 et nous ne nous intéressons qu’aux liens internes. La fonction renvoie 2 data.frames : NetwEdges pour les liens entre les pages et NetwNodes pour les noeuds ou pages.

#' 
#'
##################################################
##### Création du Réseau 

myWebsite = "https://www.anakeyn.com"

NetworkRcrawler (Website = myWebsite , no_cores = 4, no_conn = 4, 
          MaxDepth = 10,
          Obeyrobots = TRUE,
          Useragent = "Mozilla/5.0 (Windows NT 6.3; Trident/7.0; rv:11.0) like Gecko",
          NetwExtLinks = FALSE,
          MaxPagesParsed = 500)

Structures de NetwEdges et NetwNodes

Vérifions les structures des data.frames des liens et des noeuds renvoyés par NetworkRcrawler.

#' 
#'
str(NetwEdges)
str(NetwNodes)

> str(NetwEdges)
‘data.frame’: 32120 obs. of 4 variables:
$ From : num 1 1 1 1 1 1 1 1 1 1 …
$ To : num 1 2 2 1 3 4 1 5 5 5 …
$ Weight : num 1 1 1 1 1 1 1 1 1 1 …
$ PageType: num 1 1 1 1 1 1 1 1 1 1 …

Les liens ont tous un poids à 1. La variable PageType est à 1 pour toutes les pages, car nous n’avons sélectionné que des pages internes.

> str(NetwNodes)
‘data.frame’: 973 obs. of 12 variables:
$ Id : num 1 2 3 4 5 6 7 8 9 10 …
$ Url : chr « https://www.anakeyn.com » « https://www.anakeyn.com/ » « https://www.anakeyn.com/offre/ » « https://www.anakeyn.com/contact/ » …
$ MyStatusPage : chr « parsed » « parsed » « parsed » « parsed » …
$ Level : num 0 1 1 1 1 1 1 1 2 2 …
$ NbIntLinks : num 20 20 7 7 13 15 13 9 19 11 …
$ NbExtLinks : num 0 0 0 0 0 0 0 0 0 0 …
$ HttpStat : int 200 200 200 200 200 200 200 200 200 200 …
$ IntermediateHttpStat: int 200 200 200 200 200 200 200 200 200 200 …
$ ContentType : chr « text/html » « text/html » « text/html » « text/html » …
$ Encoding : chr « UTF-8 » « UTF-8 » « UTF-8 » « UTF-8 » …
$ PageType : num 1 1 1 1 1 1 1 1 1 1 …
$ HTMLContent : chr …

IntermediateHttpStat peut contenir des codes de redirections 301,302…

création du Réseau pour igraph

Le réseau est construit à partir du data.frame de liens NetwEdges

#' 
#'
#Création du Réseau pour igraph
network <- graph.data.frame(d=NetwEdges, directed = TRUE)
#Structure
networkbase <- network
head(E(networkbase)$Weight,20)

Graphe au hasard

Cette vue est sans spatialisation

#' 
#'
#Vue générale au hasard. 
plot.igraph(x = network, layout=layout.random)

Comme on l’a vu précédemment dans la création de graphe avec Gephi, la vue générale sans spatialisation se présente sous la forme d’un gros carré. Nous avons ici 973 pages.

Graphe de base

#' 
#'
#Vue Générale - Spatialisation effectuée par défaut 
plot.igraph(x = network)

La spatialisation par défaut semble faire apparaître 2 groupes

Simplification du réseau

Nous allons simplifier le réseau network en regroupant les liens multiples et en supprimant les boucles. Les poids (attribut Weight) seront regroupés.

#' 
#' 
#sauvegarde
networkbase <- network
#Regroupement des poids pour les liens multiples et suppression des liens boucles
network <- simplify(network, remove.multiple =TRUE, remove.loops = TRUE, edge.attr.comb = list(Weight="sum"))
#Vérifions que les poids sont bien différents
head(E(networkbase)$Weight,20)
head(E(network)$Weight,20)

On vérifie que l’attribut Weight a bien changé.

> head(E(networkbase)$Weight,20)
[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> head(E(network)$Weight,20)
[1] 2 1 1 4 4 4 1 1 1 1 4 4 4 1 1 2 1 1 1 2

Graphes réseau simplifié

Au hasard et avec spatialisation de base

#' 
#'
#Nouvelles vues générales sans boucles au hasard  et spatialisation de base.
plot.igraph(x = network, layout=layout.random)
plot.igraph(x = network)

Au hasard :

Spatialisation de base :

Graphes colorisation en fonction du statut http

on n’utilisera le statut IntermediateHttpStat de NetwNodes qui permet d’indentifier les redirections.
On a créé une petite fonction pour mapper les couleurs en fonctions des status.

#' 
#'
######################################################
# Fonction de mapping couleurs des status 
######################################################
mapColorByHTTPStatus <- function(thehttpstatus = NA) {
  httpstatus <- as.vector(thehttpstatus)
  theColor <- vector()
  for (i in 1:length(httpstatus)) {
    theColor[i] = "Grey"
    if (is.na(httpstatus[i])) theColor[i] = "Grey"
    else if (is.null(httpstatus[i])) theColor[i] = "Green"
    else if (httpstatus[i] == "200") theColor[i] = "Magenta"
    else if (httpstatus[i] %in% c("403","404")) theColor[i] = "Red"
    else if (httpstatus[i] %in% c("301","302")) theColor[i] = "Cyan"
  }
  return(theColor)
}
#Vue générale avec colorisation des  pages en fonction du code http 
#Redirections en cyan.
plot.igraph(network, 
            layout=layout.random,
            vertex.color = mapColorByHTTPStatus(NetwNodes$IntermediateHttpStat)
            )
#Spatialisation de base

plot.igraph(network, 
            vertex.color = mapColorByHTTPStatus(NetwNodes$IntermediateHttpStat)
)

Au hasard :

Spatialisation de base :

De nombreuses pages posent problèmes avec des status 30x et 40x

Identification des pages != 200

#' 
#'
#Mise en évidence des pages qui posent problème.
NetwNodes[!(NetwNodes$IntermediateHttpStat==200),c(2, 8)]

Url IntermediateHttpStat
15 https://www.anakeyn.com/v1 301
16 https://www.anakeyn.com/v2 301
44 https://www.anakeyn.com/services/marketing-digital/ 404
45 https://www.anakeyn.com/services/creation-web/ 404
46 https://www.anakeyn.com/services/informatique-libre/ 404
57 http://www.anakeyn.com/etudes/ 404
58 http://www.anakeyn.com/formation/ 404
61 http://www.anakeyn.com/2012/11/05/anakeyn-a-la-semaine-des-entreprises-btob-le-13-novembre-a-lorient/ 404
63 http://www.anakeyn.com/outils/semrush 404
69 http://www.anakeyn.com/ressources/etudes-internet/ 404
70 http://www.anakeyn.com/chiffres-cles/ 404
71 http://www.anakeyn.com/outils/ 404
72 http://www.anakeyn.com/category/blog/ 404
83 http://www.anakeyn.com/2013/03/02/yooda-semvisu-semrush-alexa/ 404
84 http://www.anakeyn.com/2013/04/06/le-rang-est-il-une-bonne-variable-pour-comparer-les-sites/ 404
116 http://www.anakeyn.com/2013/03/20/alexa-et-semrush-donnent-ils-des-resultats-coherents/ 404
117 http://www.anakeyn.com/2013/04/03/semrush-et-yooda-donnent-ils-des-resultats-coherents/ 404
129 https://www.anakeyn.com/2013/03/02/yooda-semvisu-semrush-alexa/ 404
130 http://www.anakeyn.com/2013/04/08/semvisu-et-semrush-sont-ils-coherents-entre-eux/ 404
315 http://www.anakeyn.com/etudes/audit-de-positionnement-de-mots-cles-dans-les-moteurs-de-recherche/ 404
317 http://www.anakeyn.com/etudes/audit-technique-pour-le-referencement-naturel-seo/ 404
318 http://www.anakeyn.com/etudes/quel-est-mon-marche-sur-l-internet/ 404
447 http://www.anakeyn.com/2012/11/06/dapres-google-trends-obama-va-gagner-les-elections-us/ 404
448 http://www.anakeyn.com/2016/08/18/donald-trump-prochain-president-usa/ 404
450 https://www.anakeyn.com/v2/2016/11/09/election-trump-mort-sondages-vs-big-data/trackback/ 302
457 https://www.anakeyn.com/v2/2015/09/04/mettre-a-jour-lien-partage-facebook/trackback/ 302
461 https://www.anakeyn.com/v2/services/marketing-digital/outils/semrush/trackback/ 302
711 https://www.anakeyn.com/v2/blog/page/1/ 301
717 https://www.anakeyn.com/v2/2013/04/06/le-rang-est-il-une-bonne-variable-pour-comparer-les-sites/trackback/ 302
724 https://www.anakeyn.com/2013/03/20/alexa-et-semrush-donnent-ils-des-resultats-coherents/ 404
725 https://www.anakeyn.com/2013/04/06/le-rang-est-il-une-bonne-variable-pour-comparer-les-sites/ 404
726 https://www.anakeyn.com/2013/04/08/semvisu-et-semrush-sont-ils-coherents-entre-eux/ 404
727 https://www.anakeyn.com/v2/2013/04/03/semrush-et-yooda-donnent-ils-des-resultats-coherents/trackback/ 302
733 https://www.anakeyn.com/2013/04/03/semrush-et-yooda-donnent-ils-des-resultats-coherents/ 404
734 https://www.anakeyn.com/v2/2013/03/20/alexa-et-semrush-donnent-ils-des-resultats-coherents/trackback/ 302
745 https://www.anakeyn.com/v2/2013/03/02/yooda-semvisu-semrush-alexa/trackback/ 302
752 https://www.anakeyn.com/v2/category/anakeyn/page/1/ 301
756 https://www.anakeyn.com/v2/category/marketing-digital/page/1/ 301
758 https://www.anakeyn.com/v2/category/centres-d-interets/page/1/ 301
796 http://www.anakeyn.com/2012/08/01/semrush-informer-javascript/ 404
813 http://www.anakeyn.com/chiffres-cles/chiffres-cles-entreprises/ 404
814 http://www.anakeyn.com/chiffres-cles/chiffres-cles-epub/ 404
823 http://www.anakeyn.com/2012/09/15/semrush-lance-une-pige-publicitaire-facebook/ 404
841 http://www.anakeyn.com/2012/06/13/infographie-sur-lutilisation-de-google-analytics/ 404
872 http://www.anakeyn.com/keywordmarket 404
892 http://www.anakeyn.com/category/blog/etudes/ 404
968 https://www.anakeyn.com/v2/2014/09/14/google-rachete-polar-booster-google/trackback/ 302

Calcul du Pagerank

Comme dans Gephi la bibliothèque igraph de R permet de calculer un Page Rank des pages dans le réseau.
Ici le réseau est dirigé. Ce Page Rank sera ensuite utilisé pour mettre en évidence les pages qui reçoivent le plus de « jus » de liens.

#' 
#'
#Calcul du page Rank
pr <- page.rank(network,directed=TRUE)

Construction de labels

Afin de ne pas surcharger les graphes on peut essayer de construire des « fichiers » de labels qui n’afficheront que certaines pages.

#' 
#'

#Construction de labels à partir des meilleurs pagerank
NewIndex <- data.frame(UrlLabel, pr$vector)
#Pour afficher les labels des pages principales.
The01percent <- quantile(NewIndex[, 2], .999)
NewIndex01 <- NewIndex
for (i in 2:nrow(NewIndex)) 
  if (NewIndex[i, 2] < The01percent) NewIndex01[i, 1] <- NA

The05percent <- quantile(NewIndex[, 2], .995)
NewIndex05 <- NewIndex
for (i in 2:nrow(NewIndex)) 
  if (NewIndex[i, 2] < The05percent) NewIndex05[i, 1] <- NA

The1percent <- quantile(NewIndex[, 2], .99)
NewIndex1 <- NewIndex
for (i in 2:nrow(NewIndex)) 
  if (NewIndex[i, 2] < The1percent) NewIndex1[i, 1] <- NA
The2percent <- quantile(NewIndex[, 2], .98)
NewIndex2 <- NewIndex
for (i in 2:nrow(NewIndex)) 
  if (NewIndex[i, 2] < The1percent) NewIndex2[i, 1] <- NA
The3percent <- quantile(NewIndex[, 2], .97)
NewIndex3 <- NewIndex
for (i in 2:nrow(NewIndex)) 
  if (NewIndex[i, 2] < The3percent) NewIndex3[i, 1] <- NA


#Construction de labels à partir des meilleurs Level
NewIndexLevel <- data.frame(UrlLabel, NetwNodes$Level) 
NewIndexLevel01 <- NewIndexLevel
for (i in 2:nrow(NewIndexLevel)) 
  if (NewIndexLevel[i, 2] > 1) NewIndexLevel01[i, 1] <- NA



#Construction de labels à partir d'es meilleurs Level'expression
TargetPages <- c("/v1/", "/v2/")
NewIndexLabel <- data.frame(UrlLabel) 
for (i in 2:nrow(NewIndexLabel)) 
  if (!(NewIndexLevel[i, 1] %in% TargetPages)) NewIndexLabel[i, 1] <- NA

Fonction de mapping pour la taille des noeuds

Cette fonction est utile pour afficher des tailles de noeuds en fonctions de groupes de valeurs.

#' 
#'
###############################################################
#Map function for nodes sizes
map <- function(x, range = c(0,1), from.range=NA) {
  if(any(is.na(from.range))) from.range <- range(x, na.rm=TRUE)
  
  ## check if all values are the same
  if(!diff(from.range)) return(
    matrix(mean(range), ncol=ncol(x), nrow=nrow(x),
           dimnames = dimnames(x)))
  
  ## map to [0,1]
  x <- (x-from.range[1])
  x <- x/diff(from.range)
  ## handle single values
  if(diff(from.range) == 0) x <- 0
  
  ## map from [0,1] to [range]
  if (range[1]>range[2]) x <- 1-x
  x <- x*(abs(diff(range))) + min(range)
  
  x[x<min(range) |="" x="">max(range)] <- NA
  
  x
}
</min(range)>

Graphe avec spatialisation Fruchterman Reingold

Comme avec Gephi nous allons appliquer une spatialisation Fruchterman Reingold à notre réseau.

#' 
#'
#############################################################
# Graphe avec spatialisation  Fruchterman Reingold

#Préparation du layout Fruchterman Reingold
lwithfr <- layout_with_fr(network, coords = NULL, dim = 2, niter = 500,
                          start.temp = sqrt(vcount(network)), grid = "auto")

#Plot du Graphe
plot.igraph(network, layout= lwithfr,
            main = paste(myWebsite,"\nfruchterman.reingold"),
            vertex.size        = map(pr$vector, c(2,30)), 
            vertex.color        = mapColorByHTTPStatus(NetwNodes$IntermediateHttpStat),
            vertex.frame.size = 0.1,
            vertex.label=NewIndexLabel$UrlLabel,
            vertex.label.color="white",
            vertex.size=1,
            edge.curved = TRUE,
            edge.lty=1,
            edge.size = .1,
            edge.width = map(E(network)$Weight, c(.1,20)),
            edge.arrow.size=0.0001
)

Merci de votre attention,

Pierre.

Si vous avez des remarques et ou des suggestions d’amélioration du code source à faire, n’hésitez pas à utiliser les commentaires.