2
$\begingroup$

What is the best way to write a quick function which takes in a vertex (of some undirected graph), and gives the value of the k-Core's in which that vertex is in?

The obvious modification of kCoreComponents[Graph,k] using Intersection is either taking ages, since it needs to re-check the core composition for each vertex (I have over 7000), or spends ages "loading" after the script is complete.

$\endgroup$
  • $\begingroup$ Please add context, and all code and data (perhaps a useful subset) necessary to recreate your problem. Also,KCoreComponents with a capital K... $\endgroup$ – Yves Klett Dec 11 '17 at 15:40
3
$\begingroup$

The following seems pretty fast:

kcores[g_, v_] := With[{max = VertexDegree[g, v]},
    DeleteCases[_->{}] @ Table[
        i -> Select[KCoreComponents[g, i], Not@*FreeQ[v]],
        {i,0,max}
    ]
]

Here is @kglr's example:

g = Graph[
    {
    1 <-> 2, 1 <-> 3, 1<-> 4, 2 <-> 3, 2 <-> 4, 3 <-> 4, 4 <-> 5, 5 <-> 6, 
    6 <-> 7, 6 <-> 8, 6 <-> 9, 7 <-> 8, 7 <-> 9, 8 <-> 9
    }
];

kcores[g, 1]
kcores[g, 5]
kcores[g, 6]

{0 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 1 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 2 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 3 -> {{1, 2, 3, 4}}}

{0 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 1 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 2 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}}

{0 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 1 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 2 -> {{1, 2, 3, 4, 5, 6, 7, 8, 9}}, 3 -> {{6, 7, 8, 9}}}

And a large example:

g = RandomGraph[{10000, 50000}];
kcores[g, 1]; //AbsoluteTiming

{0.042289, Null}

Addendum

Your question asked for the values of the k-cores (note the plural) in which that vertex is in, which is why my function returned a list of all the k-cores that a vertex lives in. Since you accepted the answer returning a single component for a specific value of k, here is a variation of my answer to do so:

kcore[g_, k_, v_] := SelectFirst[KCoreComponents[g, k], Not @* FreeQ[v]]

Let's compare kcore with the accepted answer:

g = RandomGraph[{10000, 50000}];

r1 = kcore[g, 5, 50]; //AbsoluteTiming
r2 = kCoreParent[g, 5, 50]; //AbsoluteTiming

r1 === r2

{0.006013, Null}

{0.42559, Null}

True

You did say you were interested in a quick solution.

$\endgroup$
3
$\begingroup$
ClearAll[kCoreParent]
kCoreParent[g_, k_, v_] := v /. Dispatch[Flatten[{Thread[# -> #, List, 1] & /@ 
      KCoreComponents[g, k], _ :> {}}]]

Example:

g = Graph[{1 <-> 2, 1 <-> 3, 1<-> 4, 2 <-> 3, 2 <-> 4, 3 <-> 4, 4 <-> 5, 5 <-> 6, 
   6 <-> 7, 6 <-> 8, 6 <-> 9, 7 <-> 8, 7 <-> 9, 8 <-> 9},  
  GraphStyle -> "SmallNetwork", ImageSize -> 500]

enter image description here

KCoreComponents[g, 3]

{{6, 7, 8, 9}, {1, 2, 3, 4}}

kCoreParent[g, 3, 8]

{6, 7, 8, 9}

Grid[Prepend[{#, kCoreParent[g, 3, #]} & /@ {1, 5, 7}, {"  v  ", 
   "kCoreParent[g, 3, v]"}], Dividers -> All, 
 Alignment -> {Center, Center}, ItemStyle -> Directive["Panel", 20]]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.