-
-
Notifications
You must be signed in to change notification settings - Fork 200
/
games.R
2184 lines (2049 loc) · 84.3 KB
/
games.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#' The Watts-Strogatz small-world model
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `watts.strogatz.game()` was renamed to `sample_smallworld()` to create a more
#' consistent API.
#' @inheritParams sample_smallworld
#' @keywords internal
#' @export
watts.strogatz.game <- function(dim, size, nei, p, loops = FALSE, multiple = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "watts.strogatz.game()", "sample_smallworld()")
sample_smallworld(dim = dim, size = size, nei = nei, p = p, loops = loops, multiple = multiple)
} # nocov end
#' Scale-free random graphs, from vertex fitness scores
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `static.power.law.game()` was renamed to `sample_fitness_pl()` to create a more
#' consistent API.
#' @inheritParams sample_fitness_pl
#' @keywords internal
#' @export
static.power.law.game <- function(no.of.nodes, no.of.edges, exponent.out, exponent.in = -1, loops = FALSE, multiple = FALSE, finite.size.correction = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "static.power.law.game()", "sample_fitness_pl()")
sample_fitness_pl(no.of.nodes = no.of.nodes, no.of.edges = no.of.edges, exponent.out = exponent.out, exponent.in = exponent.in, loops = loops, multiple = multiple, finite.size.correction = finite.size.correction)
} # nocov end
#' Random graphs from vertex fitness scores
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `static.fitness.game()` was renamed to `sample_fitness()` to create a more
#' consistent API.
#' @inheritParams sample_fitness
#' @keywords internal
#' @export
static.fitness.game <- function(no.of.edges, fitness.out, fitness.in = NULL, loops = FALSE, multiple = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "static.fitness.game()", "sample_fitness()")
sample_fitness(no.of.edges = no.of.edges, fitness.out = fitness.out, fitness.in = fitness.in, loops = loops, multiple = multiple)
} # nocov end
#' Sample stochastic block model
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `sbm.game()` was renamed to `sample_sbm()` to create a more
#' consistent API.
#' @inheritParams sample_sbm
#' @keywords internal
#' @export
sbm.game <- function(n, pref.matrix, block.sizes, directed = FALSE, loops = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "sbm.game()", "sample_sbm()")
sample_sbm(n = n, pref.matrix = pref.matrix, block.sizes = block.sizes, directed = directed, loops = loops)
} # nocov end
#' Trait-based random generation
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `preference.game()` was renamed to `sample_pref()` to create a more
#' consistent API.
#' @inheritParams sample_pref
#' @keywords internal
#' @export
preference.game <- function(nodes, types, type.dist = rep(1, types), fixed.sizes = FALSE, pref.matrix = matrix(1, types, types), directed = FALSE, loops = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "preference.game()", "sample_pref()")
sample_pref(nodes = nodes, types = types, type.dist = type.dist, fixed.sizes = fixed.sizes, pref.matrix = pref.matrix, directed = directed, loops = loops)
} # nocov end
#' Random citation graphs
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `lastcit.game()` was renamed to `sample_last_cit()` to create a more
#' consistent API.
#' @inheritParams sample_last_cit
#' @keywords internal
#' @export
lastcit.game <- function(n, edges = 1, agebins = n / 7100, pref = (1:(agebins + 1))^-3, directed = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "lastcit.game()", "sample_last_cit()")
sample_last_cit(n = n, edges = edges, agebins = agebins, pref = pref, directed = directed)
} # nocov end
#' Create a random regular graph
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `k.regular.game()` was renamed to `sample_k_regular()` to create a more
#' consistent API.
#' @inheritParams sample_k_regular
#' @keywords internal
#' @export
k.regular.game <- function(no.of.nodes, k, directed = FALSE, multiple = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "k.regular.game()", "sample_k_regular()")
sample_k_regular(no.of.nodes = no.of.nodes, k = k, directed = directed, multiple = multiple)
} # nocov end
#' A graph with subgraphs that are each a random graph.
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `interconnected.islands.game()` was renamed to `sample_islands()` to create a more
#' consistent API.
#' @inheritParams sample_islands
#' @keywords internal
#' @export
interconnected.islands.game <- function(islands.n, islands.size, islands.pin, n.inter) { # nocov start
lifecycle::deprecate_soft("2.0.0", "interconnected.islands.game()", "sample_islands()")
sample_islands(islands.n = islands.n, islands.size = islands.size, islands.pin = islands.pin, n.inter = n.inter)
} # nocov end
#' Geometric random graphs
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `grg.game()` was renamed to `sample_grg()` to create a more
#' consistent API.
#' @inheritParams sample_grg
#' @keywords internal
#' @export
grg.game <- function(nodes, radius, torus = FALSE, coords = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "grg.game()", "sample_grg()")
sample_grg(nodes = nodes, radius = radius, torus = torus, coords = coords)
} # nocov end
#' Growing random graph generation
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `growing.random.game()` was renamed to `sample_growing()` to create a more
#' consistent API.
#' @inheritParams sample_growing
#' @keywords internal
#' @export
growing.random.game <- function(n, m = 1, directed = TRUE, citation = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "growing.random.game()", "sample_growing()")
sample_growing(n = n, m = m, directed = directed, citation = citation)
} # nocov end
#' Forest Fire Network Model
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `forest.fire.game()` was renamed to `sample_forestfire()` to create a more
#' consistent API.
#' @inheritParams sample_forestfire
#' @keywords internal
#' @export
forest.fire.game <- function(nodes, fw.prob, bw.factor = 1, ambs = 1, directed = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "forest.fire.game()", "sample_forestfire()")
sample_forestfire(nodes = nodes, fw.prob = fw.prob, bw.factor = bw.factor, ambs = ambs, directed = directed)
} # nocov end
#' Graph generation based on different vertex types
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `establishment.game()` was renamed to `sample_traits()` to create a more
#' consistent API.
#' @inheritParams sample_traits
#' @keywords internal
#' @export
establishment.game <- function(nodes, types, k = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "establishment.game()", "sample_traits()")
sample_traits(nodes = nodes, types = types, k = k, type.dist = type.dist, pref.matrix = pref.matrix, directed = directed)
} # nocov end
#' Generate random graphs with a given degree sequence
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `degree.sequence.game()` was renamed to `sample_degseq()` to create a more
#' consistent API.
#' @inheritParams sample_degseq
#' @keywords internal
#' @export
degree.sequence.game <- function(out.deg, in.deg = NULL, method = c("simple", "vl", "simple.no.multiple", "simple.no.multiple.uniform")) { # nocov start
lifecycle::deprecate_soft("2.0.0", "degree.sequence.game()", "sample_degseq()")
sample_degseq(out.deg = out.deg, in.deg = in.deg, method = method)
} # nocov end
#' Neighborhood of graph vertices
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `connect.neighborhood()` was renamed to `connect()` to create a more
#' consistent API.
#' @inheritParams connect
#' @keywords internal
#' @export
connect.neighborhood <- function(graph, order, mode = c("all", "out", "in", "total")) { # nocov start
lifecycle::deprecate_soft("2.0.0", "connect.neighborhood()", "connect()")
connect(graph = graph, order = order, mode = mode)
} # nocov end
#' Random citation graphs
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `citing.cited.type.game()` was renamed to `sample_cit_cit_types()` to create a more
#' consistent API.
#' @inheritParams sample_cit_cit_types
#' @keywords internal
#' @export
citing.cited.type.game <- function(n, edges = 1, types = rep(0, n), pref = matrix(1, nrow = length(types), ncol = length(types)), directed = TRUE, attr = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "citing.cited.type.game()", "sample_cit_cit_types()")
sample_cit_cit_types(n = n, edges = edges, types = types, pref = pref, directed = directed, attr = attr)
} # nocov end
#' Random citation graphs
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `cited.type.game()` was renamed to `sample_cit_types()` to create a more
#' consistent API.
#' @inheritParams sample_cit_types
#' @keywords internal
#' @export
cited.type.game <- function(n, edges = 1, types = rep(0, n), pref = rep(1, length(types)), directed = TRUE, attr = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "cited.type.game()", "sample_cit_types()")
sample_cit_types(n = n, edges = edges, types = types, pref = pref, directed = directed, attr = attr)
} # nocov end
#' Graph generation based on different vertex types
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `callaway.traits.game()` was renamed to `sample_traits_callaway()` to create a more
#' consistent API.
#' @inheritParams sample_traits_callaway
#' @keywords internal
#' @export
callaway.traits.game <- function(nodes, types, edge.per.step = 1, type.dist = rep(1, types), pref.matrix = matrix(1, types, types), directed = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "callaway.traits.game()", "sample_traits_callaway()")
sample_traits_callaway(nodes = nodes, types = types, edge.per.step = edge.per.step, type.dist = type.dist, pref.matrix = pref.matrix, directed = directed)
} # nocov end
#' Bipartite random graphs
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `bipartite.random.game()` was renamed to `sample_bipartite()` to create a more
#' consistent API.
#' @inheritParams sample_bipartite
#' @keywords internal
#' @export
bipartite.random.game <- function(n1, n2, type = c("gnp", "gnm"), p, m, directed = FALSE, mode = c("out", "in", "all")) { # nocov start
lifecycle::deprecate_soft("2.0.0", "bipartite.random.game()", "sample_bipartite()")
sample_bipartite(n1 = n1, n2 = n2, type = type, p = p, m = m, directed = directed, mode = mode)
} # nocov end
#' Generate random graphs using preferential attachment
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `barabasi.game()` was renamed to `sample_pa()` to create a more
#' consistent API.
#' @inheritParams sample_pa
#' @keywords internal
#' @export
barabasi.game <- function(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "barabasi.game()", "sample_pa()")
sample_pa(n = n, power = power, m = m, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, zero.appeal = zero.appeal, directed = directed, algorithm = algorithm, start.graph = start.graph)
} # nocov end
#' Generate random graphs using preferential attachment
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `ba.game()` was renamed to `sample_pa()` to create a more
#' consistent API.
#' @inheritParams sample_pa
#' @keywords internal
#' @export
ba.game <- function(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL, out.pref = FALSE, zero.appeal = 1, directed = TRUE, algorithm = c("psumtree", "psumtree-multiple", "bag"), start.graph = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "ba.game()", "sample_pa()")
sample_pa(n = n, power = power, m = m, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, zero.appeal = zero.appeal, directed = directed, algorithm = algorithm, start.graph = start.graph)
} # nocov end
#' Trait-based random generation
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `asymmetric.preference.game()` was renamed to `sample_asym_pref()` to create a more
#' consistent API.
#' @inheritParams sample_asym_pref
#' @keywords internal
#' @export
asymmetric.preference.game <- function(nodes, types, type.dist.matrix = matrix(1, types, types), pref.matrix = matrix(1, types, types), loops = FALSE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "asymmetric.preference.game()", "sample_asym_pref()")
sample_asym_pref(nodes = nodes, types = types, type.dist.matrix = type.dist.matrix, pref.matrix = pref.matrix, loops = loops)
} # nocov end
#' Generate an evolving random graph with preferential attachment and aging
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `aging.barabasi.game()` was renamed to `sample_pa_age()` to create a more
#' consistent API.
#' @inheritParams sample_pa_age
#' @keywords internal
#' @export
aging.barabasi.game <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "aging.barabasi.game()", "sample_pa_age()")
sample_pa_age(n = n, pa.exp = pa.exp, aging.exp = aging.exp, m = m, aging.bin = aging.bin, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, directed = directed, zero.deg.appeal = zero.deg.appeal, zero.age.appeal = zero.age.appeal, deg.coef = deg.coef, age.coef = age.coef, time.window = time.window)
} # nocov end
#' Generate an evolving random graph with preferential attachment and aging
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `aging.ba.game()` was renamed to `sample_pa_age()` to create a more
#' consistent API.
#' @inheritParams sample_pa_age
#' @keywords internal
#' @export
aging.ba.game <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "aging.ba.game()", "sample_pa_age()")
sample_pa_age(n = n, pa.exp = pa.exp, aging.exp = aging.exp, m = m, aging.bin = aging.bin, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, directed = directed, zero.deg.appeal = zero.deg.appeal, zero.age.appeal = zero.age.appeal, deg.coef = deg.coef, age.coef = age.coef, time.window = time.window)
} # nocov end
#' Generate an evolving random graph with preferential attachment and aging
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `aging.prefatt.game()` was renamed to `sample_pa_age()` to create a more
#' consistent API.
#' @inheritParams sample_pa_age
#' @keywords internal
#' @export
aging.prefatt.game <- function(n, pa.exp, aging.exp, m = NULL, aging.bin = 300, out.dist = NULL, out.seq = NULL, out.pref = FALSE, directed = TRUE, zero.deg.appeal = 1, zero.age.appeal = 0, deg.coef = 1, age.coef = 1, time.window = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "aging.prefatt.game()", "sample_pa_age()")
sample_pa_age(n = n, pa.exp = pa.exp, aging.exp = aging.exp, m = m, aging.bin = aging.bin, out.dist = out.dist, out.seq = out.seq, out.pref = out.pref, directed = directed, zero.deg.appeal = zero.deg.appeal, zero.age.appeal = zero.age.appeal, deg.coef = deg.coef, age.coef = age.coef, time.window = time.window)
} # nocov end
## -----------------------------------------------------------------
## IGraph R package
## Copyright (C) 2005-2014 Gabor Csardi <csardi.gabor@gmail.com>
## 334 Harvard street, Cambridge, MA 02139 USA
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 2 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
## 02110-1301 USA
##
## -----------------------------------------------------------------
#' Generate random graphs using preferential attachment
#'
#' Preferential attachment is a family of simple stochastic algorithms for building
#' a graph. Variants include the Barabási-Abert model and the Price model.
#'
#' This is a simple stochastic algorithm to generate a graph. It is a discrete
#' time step model and in each time step a single vertex is added.
#'
#' We start with a single vertex and no edges in the first time step. Then we
#' add one vertex in each time step and the new vertex initiates some edges to
#' old vertices. The probability that an old vertex is chosen is given by
#' \deqn{P[i] \sim k_i^\alpha+a}{P[i] ~ k[i]^alpha + a} where \eqn{k_i}{k[i]}
#' is the in-degree of vertex \eqn{i} in the current time step (more precisely
#' the number of adjacent edges of \eqn{i} which were not initiated by \eqn{i}
#' itself) and \eqn{\alpha}{alpha} and \eqn{a} are parameters given by the
#' `power` and `zero.appeal` arguments.
#'
#' The number of edges initiated in a time step is given by the `m`,
#' `out.dist` and `out.seq` arguments. If `out.seq` is given and
#' not NULL then it gives the number of edges to add in a vector, the first
#' element is ignored, the second is the number of edges to add in the second
#' time step and so on. If `out.seq` is not given or null and
#' `out.dist` is given and not NULL then it is used as a discrete
#' distribution to generate the number of edges in each time step. Its first
#' element is the probability that no edges will be added, the second is the
#' probability that one edge is added, etc. (`out.dist` does not need to
#' sum up to one, it normalized automatically.) `out.dist` should contain
#' non-negative numbers and at east one element should be positive.
#'
#' If both `out.seq` and `out.dist` are omitted or NULL then `m`
#' will be used, it should be a positive integer constant and `m` edges
#' will be added in each time step.
#'
#' `sample_pa()` generates a directed graph by default, set
#' `directed` to `FALSE` to generate an undirected graph. Note that
#' even if an undirected graph is generated \eqn{k_i}{k[i]} denotes the number
#' of adjacent edges not initiated by the vertex itself and not the total
#' (in- + out-) degree of the vertex, unless the `out.pref` argument is set to
#' `TRUE`.
#'
#' @param n Number of vertices.
#' @param power The power of the preferential attachment, the default is one,
#' i.e. linear preferential attachment.
#' @param m Numeric constant, the number of edges to add in each time step This
#' argument is only used if both `out.dist` and `out.seq` are omitted
#' or NULL.
#' @param out.dist Numeric vector, the distribution of the number of edges to
#' add in each time step. This argument is only used if the `out.seq`
#' argument is omitted or NULL.
#' @param out.seq Numeric vector giving the number of edges to add in each time
#' step. Its first element is ignored as no edges are added in the first time
#' step.
#' @param out.pref Logical, if true the total degree is used for calculating
#' the citation probability, otherwise the in-degree is used.
#' @param zero.appeal The \sQuote{attractiveness} of the vertices with no
#' adjacent edges. See details below.
#' @param directed Whether to create a directed graph.
#' @param algorithm The algorithm to use for the graph generation.
#' `psumtree` uses a partial prefix-sum tree to generate the graph, this
#' algorithm can handle any `power` and `zero.appeal` values and
#' never generates multiple edges. `psumtree-multiple` also uses a
#' partial prefix-sum tree, but the generation of multiple edges is allowed.
#' Before the 0.6 version igraph used this algorithm if `power` was not
#' one, or `zero.appeal` was not one. `bag` is the algorithm that
#' was previously (before version 0.6) used if `power` was one and
#' `zero.appeal` was one as well. It works by putting the ids of the
#' vertices into a bag (multiset, really), exactly as many times as their
#' (in-)degree, plus once more. Then the required number of cited vertices are
#' drawn from the bag, with replacement. This method might generate multiple
#' edges. It only works if `power` and `zero.appeal` are equal one.
#' @param start.graph `NULL` or an igraph graph. If a graph, then the
#' supplied graph is used as a starting graph for the preferential attachment
#' algorithm. The graph should have at least one vertex. If a graph is supplied
#' here and the `out.seq` argument is not `NULL`, then it should
#' contain the out degrees of the new vertices only, not the ones in the
#' `start.graph`.
#' @return A graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @references Barabási, A.-L. and Albert R. 1999. Emergence of scaling in
#' random networks *Science*, 286 509--512.
#'
#' de Solla Price, D. J. 1965. Networks of Scientific Papers *Science*,
#' 149 510--515.
#' @family games
#' @export
#' @keywords graphs
#' @examples
#'
#' g <- sample_pa(10000)
#' degree_distribution(g)
#'
sample_pa <- function(n, power = 1, m = NULL, out.dist = NULL, out.seq = NULL,
out.pref = FALSE, zero.appeal = 1,
directed = TRUE, algorithm = c(
"psumtree",
"psumtree-multiple", "bag"
),
start.graph = NULL) {
if (!is.null(start.graph) && !is_igraph(start.graph)) {
stop("`start.graph' not an `igraph' object")
}
# Checks
if (!is.null(out.seq) && (!is.null(m) || !is.null(out.dist))) {
warning("if `out.seq' is given `m' and `out.dist' should be NULL")
m <- out.dist <- NULL
}
if (is.null(out.seq) && !is.null(out.dist) && !is.null(m)) {
warning("if `out.dist' is given `m' will be ignored")
m <- NULL
}
if (!is.null(m) && m == 0) {
warning("`m' is zero, graph will be empty")
}
if (is.null(m) && is.null(out.dist) && is.null(out.seq)) {
m <- 1
}
n <- as.numeric(n)
power <- as.numeric(power)
if (!is.null(m)) {
m <- as.numeric(m)
}
if (!is.null(out.dist)) {
out.dist <- as.numeric(out.dist)
}
if (!is.null(out.seq)) {
out.seq <- as.numeric(out.seq)
}
out.pref <- as.logical(out.pref)
if (!is.null(out.dist)) {
nn <- if (is.null(start.graph)) n else n - vcount(start.graph)
out.seq <- as.numeric(sample(0:(length(out.dist) - 1), nn,
replace = TRUE, prob = out.dist
))
}
if (is.null(out.seq)) {
out.seq <- numeric()
}
algorithm <- igraph.match.arg(algorithm)
algorithm1 <- switch(algorithm,
"psumtree" = 1,
"psumtree-multiple" = 2,
"bag" = 0
)
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_barabasi_game, n, power, m, out.seq, out.pref,
zero.appeal, directed, algorithm1, start.graph
)
if (igraph_opt("add.params")) {
res$name <- "Barabasi graph"
res$power <- power
res$m <- m
res$zero.appeal <- zero.appeal
res$algorithm <- algorithm
}
res
}
#' @rdname sample_pa
#' @param ... Passed to `sample_pa()`.
#' @export
pa <- function(...) constructor_spec(sample_pa, ...)
## -----------------------------------------------------------------
#' Generate random graphs according to the \eqn{G(n,p)} Erdős-Rényi model
#'
#' Every possible edge is created independently with the same probability `p`.
#' This model is also referred to as a Bernoulli random graph since the
#' connectivity status of vertex pairs follows a Bernoulli distribution.
#'
#' The graph has `n` vertices and each pair of vertices is connected
#' with the same probability `p`. The `loops` parameter controls whether
#' self-connections are also considered. This model effectively constrains
#' the average number of edges, \eqn{p m_\text{max}}, where \eqn{m_\text{max}}
#' is the largest possible number of edges, which depends on whether the
#' graph is directed or undirected and whether self-loops are allowed.
#'
#' @param n The number of vertices in the graph.
#' @param p The probability for drawing an edge between two
#' arbitrary vertices (\eqn{G(n,p)} graph).
#' @param directed Logical, whether the graph will be directed, defaults to
#' `FALSE`.
#' @param loops Logical, whether to add loop edges, defaults to `FALSE`.
#' @return A graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @references Erdős, P. and Rényi, A., On random graphs, *Publicationes
#' Mathematicae* 6, 290--297 (1959).
#' @family games
#' @export
#' @keywords graphs
#' @examples
#'
#' g <- sample_gnp(1000, 1 / 1000)
#' degree_distribution(g)
sample_gnp <- function(n, p, directed = FALSE, loops = FALSE) {
type <- "gnp"
type1 <- switch(type,
"gnp" = 0,
"gnm" = 1
)
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_erdos_renyi_game, as.numeric(n), as.numeric(type1),
as.numeric(p), as.logical(directed), as.logical(loops)
)
if (igraph_opt("add.params")) {
res$name <- sprintf("Erdos-Renyi (%s) graph", type)
res$type <- type
res$loops <- loops
res$p <- p
}
res
}
#' @rdname sample_gnp
#' @param ... Passed to `sample_gnp()`.
#' @export
gnp <- function(...) constructor_spec(sample_gnp, ...)
## -----------------------------------------------------------------
#' Generate random graphs according to the \eqn{G(n,m)} Erdős-Rényi model
#'
#' Random graph with a fixed number of edges and vertices.
#'
#' The graph has `n` vertices and `m` edges. The edges are chosen uniformly
#' at random from the set of all vertex pairs. This set includes potential
#' self-connections as well if the `loops` parameter is `TRUE`.
#'
#' @param n The number of vertices in the graph.
#' @param m The number of edges in the graph.
#' @param directed Logical, whether the graph will be directed, defaults to
#' `FALSE`.
#' @param loops Logical, whether to add loop edges, defaults to `FALSE`.
#' @return A graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @references Erdős, P. and Rényi, A., On random graphs, *Publicationes
#' Mathematicae* 6, 290--297 (1959).
#' @family games
#' @export
#' @keywords graphs
#' @examples
#'
#' g <- sample_gnm(1000, 1000)
#' degree_distribution(g)
sample_gnm <- function(n, m, directed = FALSE, loops = FALSE) {
type <- "gnm"
type1 <- switch(type,
"gnp" = 0,
"gnm" = 1
)
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_erdos_renyi_game, as.numeric(n), as.numeric(type1),
as.numeric(m), as.logical(directed), as.logical(loops)
)
if (igraph_opt("add.params")) {
res$name <- sprintf("Erdos-Renyi (%s) graph", type)
res$type <- type
res$loops <- loops
res$m <- m
}
res
}
#' @rdname sample_gnm
#' @param ... Passed to `sample_gnm()`.
#' @export
gnm <- function(...) constructor_spec(sample_gnm, ...)
## -----------------------------------------------------------------
#' Generate random graphs according to the Erdős-Rényi model
#'
#' Simple random graph model, specifying the edge count either precisely
#' (\eqn{G(n,m)} model) or on average through a connection probability
#' (\eqn{G(n,p)} model).
#'
#' In \eqn{G(n,m)} graphs, there are precisely `m` edges.
#'
#' In \eqn{G(n,p)} graphs, all vertex pairs are connected with the same
#' probability `p`.
#'
#' `random.graph.game()` is an alias to this function.
#'
#' @section Deprecated:
#'
#' Since igraph version 0.8.0, both `erdos.renyi.game()` and
#' `random.graph.game()` are deprecated, and [sample_gnp()] and
#' [sample_gnm()] should be used instead. See these for more details.
#'
#' @aliases erdos.renyi.game random.graph.game
#' @param n The number of vertices in the graph.
#' @param p.or.m Either the probability for drawing an edge between two
#' arbitrary vertices (\eqn{G(n,p)} graph), or the number of edges in
#' the graph (for \eqn{G(n,m)} graphs).
#' @param type The type of the random graph to create, either `gnp()`
#' (\eqn{G(n,p)} graph) or `gnm()` (\eqn{G(n,m)} graph).
#' @param directed Logical, whether the graph will be directed, defaults to
#' `FALSE`.
#' @param loops Logical, whether to add loop edges, defaults to `FALSE`.
#' @return A graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @references Erdős, P. and Rényi, A., On random graphs, *Publicationes
#' Mathematicae* 6, 290--297 (1959).
#' @family games
#' @export
#' @keywords graphs
#' @keywords internal
#' @examples
#'
#' g <- erdos.renyi.game(1000, 1 / 1000)
#' degree_distribution(g)
#'
erdos.renyi.game <- function(n, p.or.m, type = c("gnp", "gnm"),
directed = FALSE, loops = FALSE) {
type <- igraph.match.arg(type)
type1 <- switch(type,
"gnp" = 0,
"gnm" = 1
)
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_erdos_renyi_game, as.numeric(n), as.numeric(type1),
as.numeric(p.or.m), as.logical(directed), as.logical(loops)
)
if (igraph_opt("add.params")) {
res$name <- sprintf("Erdos-Renyi (%s) graph", type)
res$type <- type
res$loops <- loops
if (type == "gnp") {
res$p <- p.or.m
}
if (type == "gnm") {
res$m <- p.or.m
}
}
res
}
#' @family games
#' @export
random.graph.game <- erdos.renyi.game
## -----------------------------------------------------------------
#' Generate random graphs with a given degree sequence
#'
#' It is often useful to create a graph with given vertex degrees. This function
#' creates such a graph in a randomized manner.
#'
#' The \dQuote{simple} method connects the out-stubs of the edges (undirected
#' graphs) or the out-stubs and in-stubs (directed graphs) together. This way
#' loop edges and also multiple edges may be generated. This method is not
#' adequate if one needs to generate simple graphs with a given degree
#' sequence. The multiple and loop edges can be deleted, but then the degree
#' sequence is distorted and there is nothing to ensure that the graphs are
#' sampled uniformly.
#'
#' The \dQuote{simple.no.multiple} method is similar to \dQuote{simple}, but
#' tries to avoid multiple and loop edges and restarts the generation from
#' scratch if it gets stuck. It is not guaranteed to sample uniformly from the
#' space of all possible graphs with the given sequence, but it is relatively
#' fast and it will eventually succeed if the provided degree sequence is
#' graphical, but there is no upper bound on the number of iterations.
#'
#' The \dQuote{simple.no.multiple.uniform} method is a variant of
#' \dQuote{simple.no.multiple} with the added benefit of sampling uniformly
#' from the set of all possible simple graphs with the given degree sequence.
#' Ensuring uniformity has some performance implications, though.
#'
#' The \dQuote{vl} method is a more sophisticated generator. The algorithm and
#' the implementation was done by Fabien Viger and Matthieu Latapy. This
#' generator always generates undirected, connected simple graphs, it is an
#' error to pass the `in.deg` argument to it. The algorithm relies on
#' first creating an initial (possibly unconnected) simple undirected graph
#' with the given degree sequence (if this is possible at all). Then some
#' rewiring is done to make the graph connected. Finally a Monte-Carlo
#' algorithm is used to randomize the graph. The \dQuote{vl} samples from the
#' undirected, connected simple graphs uniformly.
#'
#' @param out.deg Numeric vector, the sequence of degrees (for undirected
#' graphs) or out-degrees (for directed graphs). For undirected graphs its sum
#' should be even. For directed graphs its sum should be the same as the sum of
#' `in.deg`.
#' @param in.deg For directed graph, the in-degree sequence. By default this is
#' `NULL` and an undirected graph is created.
#' @param method Character, the method for generating the graph. Right now the
#' \dQuote{simple}, \dQuote{simple.no.multiple} and \dQuote{vl} methods are
#' implemented.
#' @return The new graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @seealso
#' [simplify()] to get rid of the multiple and/or loops edges,
#' [realize_degseq()] for a deterministic variant.
#' @family games
#' @export
#' @keywords graphs
#' @examples
#'
#' ## The simple generator
#' g <- sample_degseq(rep(2, 100))
#' degree(g)
#' is_simple(g) # sometimes TRUE, but can be FALSE
#' g2 <- sample_degseq(1:10, 10:1)
#' degree(g2, mode = "out")
#' degree(g2, mode = "in")
#'
#' ## The vl generator
#' g3 <- sample_degseq(rep(2, 100), method = "vl")
#' degree(g3)
#' is_simple(g3) # always TRUE
#'
#' ## Exponential degree distribution
#' ## Note, that we correct the degree sequence if its sum is odd
#' degs <- sample(1:100, 100, replace = TRUE, prob = exp(-0.5 * (1:100)))
#' if (sum(degs) %% 2 != 0) {
#' degs[1] <- degs[1] + 1
#' }
#' g4 <- sample_degseq(degs, method = "vl")
#' all(degree(g4) == degs)
#'
#' ## Power-law degree distribution
#' ## Note, that we correct the degree sequence if its sum is odd
#' degs <- sample(1:100, 100, replace = TRUE, prob = (1:100)^-2)
#' if (sum(degs) %% 2 != 0) {
#' degs[1] <- degs[1] + 1
#' }
#' g5 <- sample_degseq(degs, method = "vl")
#' all(degree(g5) == degs)
sample_degseq <- function(out.deg, in.deg = NULL,
method = c("simple", "vl", "simple.no.multiple", "simple.no.multiple.uniform")) {
method <- igraph.match.arg(method)
method1 <- switch(method,
"simple" = 0,
"vl" = 1,
"simple.no.multiple" = 2,
"simple.no.multiple.uniform" = 3
)
if (!is.null(in.deg)) {
in.deg <- as.numeric(in.deg)
}
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_degree_sequence_game, as.numeric(out.deg),
in.deg, as.numeric(method1)
)
if (igraph_opt("add.params")) {
res$name <- "Degree sequence random graph"
res$method <- method
}
res
}
#' @rdname sample_degseq
#' @param deterministic Whether the construction should be deterministic
#' @param ... Passed to `realize_degseq()` if \sQuote{deterministic} is true,
#' or to `sample_degseq()` otherwise.
#' @export
degseq <- function(..., deterministic = FALSE) {
constructor_spec(
if (deterministic) realize_degseq else sample_degseq, ...
)
}
## -----------------------------------------------------------------
#' Growing random graph generation
#'
#' This function creates a random graph by simulating its stochastic evolution.
#'
#' This is discrete time step model, in each time step a new vertex is added to
#' the graph and `m` new edges are created. If `citation` is
#' `FALSE` these edges are connecting two uniformly randomly chosen
#' vertices, otherwise the edges are connecting new vertex to uniformly
#' randomly chosen old vertices.
#'
#' @param n Numeric constant, number of vertices in the graph.
#' @param m Numeric constant, number of edges added in each time step.
#' @param directed Logical, whether to create a directed graph.
#' @param citation Logical. If `TRUE` a citation graph is created, i.e. in
#' each time step the added edges are originating from the new vertex.
#' @return A new graph object.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @family games
#' @export
#' @keywords graphs
#' @examples
#'
#' g <- sample_growing(500, citation = FALSE)
#' g2 <- sample_growing(500, citation = TRUE)
#'
sample_growing <- function(n, m = 1, directed = TRUE, citation = FALSE) {
on.exit(.Call(R_igraph_finalizer))
res <- .Call(
R_igraph_growing_random_game, as.numeric(n), as.numeric(m),
as.logical(directed), as.logical(citation)
)
if (igraph_opt("add.params")) {
res$name <- "Growing random graph"
res$m <- m
res$citation <- citation
}
res
}
#' @rdname sample_growing
#' @param ... Passed to `sample_growing()`.
#' @export
growing <- function(...) constructor_spec(sample_growing, ...)
## -----------------------------------------------------------------
#' Generate an evolving random graph with preferential attachment and aging
#'
#' This function creates a random graph by simulating its evolution. Each time
#' a new vertex is added it creates a number of links to old vertices and the
#' probability that an old vertex is cited depends on its in-degree
#' (preferential attachment) and age.
#'
#' This is a discrete time step model of a growing graph. We start with a
#' network containing a single vertex (and no edges) in the first time step.
#' Then in each time step (starting with the second) a new vertex is added and
#' it initiates a number of edges to the old vertices in the network. The
#' probability that an old vertex is connected to is proportional to
#' \deqn{P[i] \sim (c\cdot k_i^\alpha+a)(d\cdot l_i^\beta+b)}.
#'
#' Here \eqn{k_i}{k[i]} is the in-degree of vertex \eqn{i} in the current time
#' step and \eqn{l_i}{l[i]} is the age of vertex \eqn{i}. The age is simply
#' defined as the number of time steps passed since the vertex is added, with
#' the extension that vertex age is divided to be in `aging.bin` bins.
#'
#' \eqn{c}, \eqn{\alpha}{alpha}, \eqn{a}, \eqn{d}, \eqn{\beta}{beta} and
#' \eqn{b} are parameters and they can be set via the following arguments:
#' `pa.exp` (\eqn{\alpha}{alpha}, mandatory argument), `aging.exp`
#' (\eqn{\beta}{beta}, mandatory argument), `zero.deg.appeal` (\eqn{a},
#' optional, the default value is 1), `zero.age.appeal` (\eqn{b},
#' optional, the default is 0), `deg.coef` (\eqn{c}, optional, the default
#' is 1), and `age.coef` (\eqn{d}, optional, the default is 1).
#'
#' The number of edges initiated in each time step is governed by the `m`,
#' `out.seq` and `out.pref` parameters. If `out.seq` is given
#' then it is interpreted as a vector giving the number of edges to be added in
#' each time step. It should be of length `n` (the number of vertices),
#' and its first element will be ignored. If `out.seq` is not given (or
#' NULL) and `out.dist` is given then it will be used as a discrete
#' probability distribution to generate the number of edges. Its first element
#' gives the probability that zero edges are added at a time step, the second
#' element is the probability that one edge is added, etc. (`out.seq`
#' should contain non-negative numbers, but if they don't sum up to 1, they
#' will be normalized to sum up to 1. This behavior is similar to the
#' `prob` argument of the `sample` command.)
#'
#' By default a directed graph is generated, but it `directed` is set to
#' `FALSE` then an undirected is created. Even if an undirected graph is
#' generated \eqn{k_i}{k[i]} denotes only the adjacent edges not initiated by
#' the vertex itself except if `out.pref` is set to `TRUE`.
#'
#' If the `time.window` argument is given (and not NULL) then
#' \eqn{k_i}{k[i]} means only the adjacent edges added in the previous
#' `time.window` time steps.
#'
#' This function might generate graphs with multiple edges.
#'
#' @param n The number of vertices in the graph.
#' @param pa.exp The preferential attachment exponent, see the details below.
#' @param aging.exp The exponent of the aging, usually a non-positive number,
#' see details below.
#' @param m The number of edges each new vertex creates (except the very first
#' vertex). This argument is used only if both the `out.dist` and
#' `out.seq` arguments are NULL.
#' @param aging.bin The number of bins to use for measuring the age of
#' vertices, see details below.
#' @param out.dist The discrete distribution to generate the number of edges to
#' add in each time step if `out.seq` is NULL. See details below.
#' @param out.seq The number of edges to add in each time step, a vector
#' containing as many elements as the number of vertices. See details below.
#' @param out.pref Logical constant, whether to include edges not initiated by
#' the vertex as a basis of preferential attachment. See details below.
#' @param directed Logical constant, whether to generate a directed graph. See
#' details below.
#' @param zero.deg.appeal The degree-dependent part of the
#' \sQuote{attractiveness} of the vertices with no adjacent edges. See also
#' details below.
#' @param zero.age.appeal The age-dependent part of the \sQuote{attrativeness}
#' of the vertices with age zero. It is usually zero, see details below.
#' @param deg.coef The coefficient of the degree-dependent
#' \sQuote{attractiveness}. See details below.
#' @param age.coef The coefficient of the age-dependent part of the
#' \sQuote{attractiveness}. See details below.
#' @param time.window Integer constant, if NULL only adjacent added in the last
#' `time.windows` time steps are counted as a basis of the preferential
#' attachment. See also details below.
#' @return A new graph.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}