3
$\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$
1
  • $\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
    Commented Dec 11, 2017 at 15:40

2 Answers 2

4
$\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$
1
  • $\begingroup$ Nice, thank you $\endgroup$
    – apg
    Commented Feb 26, 2018 at 11:12
4
$\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 and acknowledge you have read our privacy policy.

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