Dibuixar hipergrafs amb Mathematica

Últimament estic treballant amb hipergrafs, i necessitava una eina per visualtizar-los fàcilment (preferentment, en Mathematica). No n’he trobat cap, així que he adaptat la funció GraphPlotHighlight, de simonjtyler. Al final del post copio les funcions necessàries, però comencem per algunes definicions matemàtiques i algun exemple.

Un hipergraph és una parella de conjunts , on és el conjunt de nodes () i és el conjunt d’hiperarestes (subconjunts de diferents del conjunt buit): . Un hipergraph és -uniforme (i escrivim ) si totes les seves hiperarestes tenen exactament elements. És a dir, . Amb aquestes definicions un graf normal i corrent és un hipergraf -uniforme.

El problema a l’hora de visualitzar un hipergraf és com dibuixar les hieprarestes. Una opció és dibuixar una àrea que inclogui els nodes continguts en l’hiperaresta. Una altra opció és dibuixar una aresta simple (és a dir, connectant només dos nodes) per cada parella de nodes dins d’una hiperaresta. En aquest cas, però, és fàcil confondre l’hipergraf amb un graf estàndard, o confondre arestes simples que corresponen a hiperarestes diferents. El que he fet amb la funció HypergraphPlotHighlight és combinar les dues opcions (dibuixant àrees i arestes simples), i a més diferenciar hiperarestes diferents amb colors diferents. El resultat encara no és òptim, però poc a poc s’hi acosta.

El següent exemple representa l’hipergraph amb E={{1, 2, 3}, {2, 3, 4}, {4, 5, 6, 9, 10}, {3, 5, 7, 8}, {1, 3, 8}, {7,  9}}:

Mathematica: línies blanques en les regions del ContourPlot, RegionPlot i similars

La funció ContourPlot del Mathematica et genera el contorn d’una funció de dues variables, . RegionPlot fa una cosa similar. Si feu servir sovint el Mathematica segurament les coneixeu.

Si a més heu d’enviar articles a revista que et demanen les figures en format EPS (o PDF), segurament també us haurem trobat que el plot al Mathematica es veu bé, però una vegada l’exporteu via un

Export["figura.eps",fig]

la figura que us resulta té aquesta pinta:

Això és perquè el Mathematica “omple” les regions dibuixant petits triangles, i les arestes d’aquests triangles (que en principi haurien de ser invisibles, però no s’exporten bé) no se superposen, de manera que s’acaben veient a l’arxiu exportat. Després de barallar-m’hi una bona estona, he trobat (en aquest enllaç) la següent solució, que bàsicament el que fa és acolorir l’aresta de cada triangle amb el color del seu triangle:

Export["figura.eps",fig/. {EdgeForm[],
r_?(MemberQ[{RGBColor, Hue, CMYKColor, GrayLevel}, Head[#]] &),
i___} :> {EdgeForm[r], r, i}]

El resultat és el que s’esperaria:

Pels interessats amb temps, sembla ser que hi ha solucions més generals i robustes aquí.

Els sistemes D’Hondt i Sainte-Laguë

El conegut —i criticat— sistema D’Hondt, l’utilitzat a Espanya, és un mètode de representació que assigna escons proporcionalment als resultats obtinguts per llistes de partits. És de la família dels mètodes de les “mitjanes més altes“, que inclou també el mètode Sainte-Laguë.

En aquests mètodes, els vots que rep cada partit es divideixen per una successió de divisors, obtenint una llista de quocients. Els escons s’assignen llavors als quocients més elevats, garantint una certa proporcionalitat. La diferència entre els divisors utilitzats dóna lloc a mètodes diferents: en el cas D’Hondt, s’utilitza la successió 1, 2, 3…, mentre que pel Sainte-Laguë s’utilitza 1, 3, 5… Així, la manera de calcular els quocients de cada partit en aquests dos mètodes és

on és el número total de vots del partit en qüestió, és el número d’escons que aquest partit ja ha rebut (començant des de 0) i és un coeficient que depèn del mètode ( per el sistema D’Hondt i pel Sainte-Laguë). El D’Hondt tendeix a donar als partits majoritaris una sobre-representació en la proporció d’escons respecte la proporció de vots, mentre que el Saint-Laguë respecta més la proporcionalitat.

Aquests sistemes sovint es modifiquen introduint un llindar, de manera que una llista que no obté aquest llindar no entra a la repartició d’escons. En el cas de les estatals espanyoles, el llindar és del 3% del total de vots en cada circumscripció electoral (que corresponen a les províncies).

Les següents funcions per a Mathematica simulen la repartició d’escons. Els paràmetres són vots, que és una llista dels vots obtinguts per cada partit amb el format

{{"Partit A", votsA}, {"Partit B", votsB}, ...}

n, que és el total d’escons a repartit i llindar (opcional, per defecte 0), que és la fracció mínima per entrar a la repartició (en el cas de les estatals espanyoles, com he dit abans, 0.03).

DHondt[vots_List, n_Integer, llindar_: 0] := Module[
  {taula, tall, votsTotal},

  votsTotal = Plus @@ vots[[All, 2]];

  taula = Table[
    {
     vots[[i, 1]],
     If[vots[[i, 2]] >= (llindar votsTotal),
        vots[[i, 2]]/#,
        0
        ] & /@ Range[n]
     }, {i, 1, Length[vots]}
    ];

  tall = Sort[Flatten[taula[[All, 2]]], Greater][[n]];

  Table[{
    taula[[i, 1]],
    Count[taula[[i, 2]], a_ /; a >= tall]
    }, {i, 1, Length[taula]}
   ]
  ]
SainteLague[vots_List, n_Integer, llindar_: 0] := Module[
  {taula, tall, votsTotal},

  votsTotal = Plus @@ vots[[All, 2]];

  taula = Table[
    {
     vots[[i, 1]],
     If[vots[[i, 2]] >= (llindar votsTotal),
        vots[[i, 2]]/(2 # + 1),
        0
        ] & /@ Range[0, n - 1]
     }, {i, 1, Length[vots]}
    ];

  tall = Sort[Flatten[taula[[All, 2]]], Greater][[n]];

  Table[{
    taula[[i, 1]],
    Count[taula[[i, 2]], a_ /; a >= tall]
    }, {i, 1, Length[taula]}
   ]
  ]

Actualització (07/12/2011): He tret el Floor[], que com diu en Bernat en un comentari no té sentit.

Jugant amb la funció CountryData[] del Mathematica

Buscant coses per l’ajuda del Mathematica, avui he trobat la funció CountryData i hi he estat jugant una mica. Resulta que conté un munt d’informació sobre els països del món, i que a més hi ha funcions similars com CityData. Us en posaré un exemple senzill: construïm un graph on els vèrtexs són els països llistats a CountryData, i una aresta uneix dos països si aquests són veïns. Per fer-ho una mica més atractiu visualment, pintarem els vèrtexs en funció del continent al qual pertanyen d’acord amb els colors del Risk. Les arestes tindran també el color del continent si uneixen dos països del mateix continent, o gris si serveixen de pont entre dos continents.

Primer ens fem una funció per a assignar un color a cada continent:

RiskColorsList = {
 {"Africa", Darker[Brown]},
 {"Asia", Darker[Green]},
 {"Europe", Darker[Blue]},
 {"NorthAmerica", Darker[Yellow]},
 {"Oceania", Darker[Purple]},
 {"SouthAmerica", Darker[Red]}
 };

RiskColor[continent_] := If[MemberQ[RiskColorsList[[All, 1]], continent],
  Select[RiskColorsList, #[[1]] == continent &][[1, 2]]
  ,
  Black
  ]

Ara ja podem dibuixar el graf amb tots els països,

GraphPlot[
  Flatten[Thread[# -> CountryData[#, "BorderingCountries"]] & /@
     CountryData[]]~Join~Flatten[{# -> #} & /@ CountryData[]],
  VertexLabeling -> Tooltip, MultiedgeStyle -> None,
  SelfLoopStyle -> None,
  VertexRenderingFunction -> ({PointSize[Large],
      RiskColor[CountryData[#2, "Continent"]],
      Tooltip[Point[#1], #2]} &),
  EdgeRenderingFunction -> ({If[
       CountryData[#2[[1]], "Continent"] !=
        CountryData[#2[[2]], "Continent"], Gray,
       RiskColor[CountryData[#2[[1]], "Continent"]]], Line[#1]} &),
  ImageSize -> Large
  ]

Queden els continents força ben delimitats, oi? Oceania, de color lila, destaca poc perquè els països tenen pocs veïns. Podem situar els vèrtexs al que seria el centre geogràfic de cada país, a veure si el graf agafa una mica la forma dels continents:

GraphPlot[
 Flatten[Thread[# -> CountryData[#, "BorderingCountries"]] & /@
    CountryData[]]~Join~Flatten[{# -> #} & /@ CountryData[]],
 VertexLabeling -> Tooltip, MultiedgeStyle -> None,
 SelfLoopStyle -> None,
 VertexCoordinateRules ->
  Flatten[{# -> ({#2, #1} & @@
         CountryData[#, "CenterCoordinates"])} & /@ CountryData[]],
 VertexRenderingFunction -> ({PointSize[Large],
     RiskColor[CountryData[#2, "Continent"]],
     Tooltip[Point[#1], #2]} &),
 EdgeRenderingFunction -> ({If[
      CountryData[#2[[1]], "Continent"] !=
       CountryData[#2[[2]], "Continent"], Gray,
      RiskColor[CountryData[#2[[1]], "Continent"]]], Line[#1]} &),
 ImageSize -> Large
 ]

Prou bé. Posem-hi el mapa del món per sota:

Show[CountryData["World", "Shape"], %]

Ecco fatto. No queda del tot ben centrat, però aquesta és la idea. Hi ha moltes més dades, a més. Seria divertit per exemple fer el graf dels països relacionats per llengües, per importacions i exportacions, etc. Un altre dia.

Símbol copyleft al Mathematica

Estava mirant els símbols que té el Mathematica i he vist que hi ha el copyright, \[Copyright], però evidentment no el copyleft. Provant una mica he vist que es pot aconseguir ràpidament amb Rotate[\[Copyright], 180 Degree]. El resultat queda girat i no reflexat, que no és perfecte, però fa el fet. El problema és que llavors no es pot utilitzar com a símbol per assignar-li un valor. Ja sé que són ganes utilitzar-lo així, però amb el copyright sí que es pot fer i això sempre em pica una mica. De totes maneres, tampoc no està en format text, sinó que cal fer primer Text[Rotate[\[Copyright], 180 Degree]] per a poder-lo utilitzar com a cadena. Per exemple, Text[Rotate[\[Copyright], 180 Degree]] <> " 2010".

Algú s’ha trobat amb el mateix? Com ho solucioneu? Sabeu si es poden crear símbols nous? No n’he sabut trobar res a l’ajuda.