forked from r-lib/pkgdepends
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsolve.R
1565 lines (1350 loc) · 50.3 KB
/
solve.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 dependency solver
#'
#' The dependency solver takes the resolution information, and works out
#' the exact versions of each package that must be installed, such that
#' version and other requirements are satisfied.
#'
#' ## Solution policies
#'
#' The dependency solver currently supports two policies: `lazy` and
#' `upgrade`. The `lazy` policy prefers to minimize installation time,
#' and it does not perform package upgrades, unless version requirements
#' require them. The `upgrade` policy prefers to update all package to
#' their latest possible versions, but it still considers that version
#' requirements.
#'
#' ## The integer problem
#'
#' Solving the package dependencies requires solving an integer linear
#' problem (ILP). This subsection briefly describes how the problem is
#' represented as an integer problem, and what the solution policies
#' exactly mean.
#'
#' Every row of the package resolution is a candidate for the dependency
#' solver. In the integer problem, every candidate corresponds to a binary
#' variable. This is 1 if that candidate is selected as part of the
#' solution, and 0 otherwise.
#'
#' The objective of the ILP minimization is defined differently for
#' different solution policies. The ILP conditions are the same.
#'
#' 1. For the `lazy` policy, `installed::` packaged get 0 points, binary
#' packages 1 point, sources packages 5 points.
#' 2. For the 'upgrade' policy, we rank all candidates for a given package
#' according to their version numbers, and assign more points to older
#' versions. Points are assigned by 100 and candidates with equal
#' versions get equal points. We still prefer installed packages to
#' binaries to source packages, so also add 0 point for already
#' installed candidates, 1 extra points for binaries and 5 points for
#' source packages.
#' 3. For directly specified refs, we aim to install each package exactly
#' once. So for these we require that the variables corresponding to
#' the same package sum up to 1.
#' 4. For non-direct refs (i.e. dependencies), we require that the
#' variables corresponding to the same package sum up to at most one.
#' Since every candidate has at least 1 point in the objective function
#' of the minimization problem, non-needed dependencies will be
#' omitted.
#' 5. For direct refs, we require that their candidates satisfy their
#' references. What this means exactly depends on the ref types. E.g.
#' for CRAN packages, it means that a CRAN candidate must be selected.
#' For a standard ref, a GitHub candidate is OK as well.
#' 6. We rule out candidates for which the dependency resolution failed.
#' 7. We go over all the dependency requirements and rule out packages
#' that do not meet them. For every package `A`, that requires
#' package `B`, we select the `B(i, i=1..k)` candidates of `B` that
#' satisfy `A`'s requirements and add a `A - B(1) - ... - B(k) <= 0`
#' rule. To satisfy this rule, either we cannot install `A`, or if `A`
#' is installed, then one of the good `B` candidates must be installed
#' as well.
#' 8. We rule out non-installed CRAN and Bioconductor candidates for
#' packages that have an already installed candidate with the same exact
#' version.
#' 9. We also rule out source CRAN and Bioconductor candidates for
#' packages that have a binary candidate with the same exact version.
#'
#' ## Explaining why the solver failed
#'
#' To be able to explain why a solution attempt failed, we also add a dummy
#' variable for each directly required package. This dummy variable has a
#' very large objective value, and it is only selected if there is no
#' way to install the directly required package.
#'
#' After a failed solution, we look the dummy variables that were selected,
#' to see which directly required package failed to solve. Then we check
#' which rule(s) ruled out the installation of these packages, and their
#' dependencies, recursively.
#'
#' ## The result
#'
#' The result of the solution is a `pkg_solution_result` object. It is a
#' named list with entries:
#'
#' * `status`: Status of the solution attempt, `"OK"` or `"FAILED"`.
#' * `data`: The selected candidates. This is very similar to a
#' [pkg_resolution_result] object, but it has two extra columns:
#' * `lib_status`: status of the package in the library, after the
#' installation. Possible values: `new` (will be newly installed),
#' `current` (up to date, not installed), `update` (will be updated),
#' `no-update` (could update, but will not).
#' * `old_version`: The old (current) version of the package in the
#' library, or `NA` if the package is currently not installed.
#' * `problem`: The ILP problem. The exact representation is an
#' implementation detail, but it does have an informative print method.
#' * `solution`: The return value of the internal solver.
#'
#' @name pkg_solution
#' @aliases pkg_solution_result
NULL
solve_dummy_obj <- 1000000000
pkgplan_solve <- function(self, private, policy) {
"!DEBUG starting to solve `length(private$resolution$packages)` packages"
if (is.null(private$config$get("library"))) {
throw(pkg_error( # nocov start
"No package library specified for installation plan.",
i = "Maybe you need to specify {.code config = list(library = ...)}
in {.code pkg_installation_plan$new()} or another initializer?"
)) # nocov end
}
if (is.null(private$resolution)) self$resolve()
if (private$dirty) {
throw(pkg_error( # nocov start
"Package list has changed, you need to call the {.code $resolve()}
method again?"
)) # nocov end
}
metadata <- list(solution_start = Sys.time())
pkgs <- self$get_resolution()
rversion <- private$config$get("r_versions")
prb <- private$create_lp_problem(pkgs, policy)
sol <- private$solve_lp_problem(prb)
if (sol$status != 0) {
throw(pkg_error( # nocov start
"Error in dependency solver, cannot solve installation.",
i = "Solver status: {sol$status}.",
i = msg_internal_error()
)) # nocov end
}
selected <- as.logical(sol$solution[seq_len(nrow(pkgs))])
res <- list(
status = if (sol$objval < solve_dummy_obj - 1) "OK" else "FAILED",
data = private$subset_resolution(selected),
problem = prb,
solution = sol
)
lib_status <- calculate_lib_status(res$data, pkgs)
res$data <- as_data_frame(cbind(res$data, lib_status))
res$data$cache_status <-
calculate_cache_status(res$data, private$cache)
metadata$solution_end <- Sys.time()
attr(res, "metadata") <- modifyList(attr(pkgs, "metadata"), metadata)
class(res) <- unique(c("pkg_solution_result", class(res)))
if (res$status == "FAILED") {
res$failures <- describe_solution_error(pkgs, res)
}
private$solution$result <- res
self$get_solution()
}
pkgplan_stop_for_solve_error <- function(self, private) {
if (is.null(private$solution)) {
throw(pkg_error( # nocov start
"You need to call the {.code $solve()} method first."
)) # nocov end
}
sol <- self$get_solution()
if (sol$status != "OK") {
msg <- paste(format(sol$failures), collapse = "\n")
throw(new_error(
"Could not solve package dependencies:\n",
msg,
call. = FALSE
))
}
}
pkgplan__create_lp_problem <- function(self, private, pkgs, policy) {
pkgplan_i_create_lp_problem(pkgs, private$config, policy)
}
## Add a condition, for a subset of variables, with op and rhs
pkgplan_i_lp_add_cond <- function(
lp, vars, op = "<=", rhs = 1, coef = rep(1, length(vars)),
type = NA_character_, note = NULL) {
lp$conds[[length(lp$conds)+1]] <-
list(vars = vars, coef = coef, op = op, rhs = rhs, type = type,
note = note)
lp
}
## This is a separate function to make it testable without a `remotes`
## object.
##
## Variables:
## * 1:num are candidates
## * (num+1):(num+num_direct_pkgs) are the relax variables for direct refs
pkgplan_i_create_lp_problem <- function(pkgs, config, policy) {
"!DEBUG creating LP problem"
## TODO: we could already rule out (standard) source packages if binary
## with the same version is present
## TODO: we could already rule out (standard) source and binary packages
## if an installed ref with the same version is present
rversion <- config$get("r_versions")
lp <- pkgplan_i_lp_init(pkgs, config, policy)
lp <- pkgplan_i_lp_objectives(lp)
lp <- pkgplan_i_lp_os_type(config, lp)
lp <- pkgplan_i_lp_force_source(lp)
lp <- pkgplan_i_lp_failures(lp)
lp <- pkgplan_i_lp_ignore(lp)
lp <- pkgplan_i_lp_platforms(lp)
lp <- pkgplan_i_lp_no_multiples(lp)
lp <- pkgplan_i_lp_rversion(lp, rversion)
lp <- pkgplan_i_lp_satisfy_direct(lp)
lp <- pkgplan_i_lp_latest_direct(lp)
lp <- pkgplan_i_lp_latest_within_repo(lp)
lp <- pkgplan_i_lp_prefer_installed(lp)
lp <- pkgplan_i_lp_deduplicate(lp, config)
lp <- pkgplan_i_lp_prefer_binaries(lp)
lp <- pkgplan_i_lp_prefer_new_binaries(lp)
lp <- pkgplan_i_lp_dependencies(lp, config)
lp
}
pkgplan_i_lp_init <- function(pkgs, config, policy) {
num_candidates <- nrow(pkgs)
packages <- unique(pkgs$package)
direct_packages <- unique(pkgs$package[pkgs$direct])
indirect_packages <- setdiff(packages, direct_packages)
num_direct <- length(direct_packages)
structure(list(
## Configuration
config = config,
## Number of package candidates
num_candidates = num_candidates,
## Number of directly specified ones
num_direct = num_direct,
## Total number of variables. For direct ones, we have an extra variable
total = num_candidates + num_direct,
## Constraints to fill in
conds = list(),
pkgs = pkgs,
policy = policy,
## All package names
packages = packages,
## The names of the direct packages
direct_packages = direct_packages,
## The names of the indirect packages
indirect_packages = indirect_packages,
## Candidates (indices) that have been ruled out. E.g. resolution failed
ruled_out = integer()
), class = "pkgplan_lp_problem")
}
## Coefficients of the objective function, this is very easy
## TODO: use rversion as well, for installed and binary packages
pkgplan_i_lp_objectives <- function(lp) {
pkgs <- lp$pkgs
policy <- lp$policy
num_candidates <- lp$num_candidates
if (policy == "lazy") {
## Simple: installed < binary < source
lp$obj <- ifelse(pkgs$type == "installed", 0,
ifelse(pkgs$platform == "source", 5, 1))
} else if (policy == "upgrade") {
## Sort the candidates of a package according to version number
lp$obj <- rep((num_candidates + 1) * 100, num_candidates)
whpp <- pkgs$status == "OK" & !is.na(pkgs$version)
pn <- unique(pkgs$package[whpp])
for (p in pn) {
whp <- whpp & pkgs$package == p
v <- pkgs$version[whp]
r <- rank(package_version(v), ties.method = "min")
lp$obj[whp] <- (max(r) - r + 1) * 100
lp$obj[whp] <- lp$obj[whp] - min(lp$obj[whp])
}
lp$obj <- lp$obj + ifelse(pkgs$type == "installed", 1,
ifelse(pkgs$platform == "source", 3, 2))
lp$obj <- lp$obj - min(lp$obj)
} else {
throw(pkg_error( # nocov start
"Unknown version selection policy: {.val {policy}}.",
i = "It has to be one of {.val lazy} or {.val upgrade}."
)) # nocov end
}
lp$obj <- c(lp$obj, rep(solve_dummy_obj, lp$num_direct))
lp
}
pkgplan_i_lp_os_type <- function(config, lp) {
if (config$get("goal") != "install") return(lp)
if (! "os_type" %in% names(lp$pkgs)) return(lp)
os <- os_type()
bad <- which(!is.na(lp$pkgs$os_type) & lp$pkgs$os_type != os)
for (wh in bad) {
lp <- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0,
type = "matching-platform")
}
lp$ruled_out <- c(lp$ruled_out, bad)
lp
}
pkgplan_i_lp_force_source <- function(lp) {
# if source package is forced, then rule out binaries
src_req <- vlapply(lp$pkgs$params, is_true_param, "source")
not_src <- lp$pkgs$platform != "source"
bad <- which(src_req & not_src)
for (wh in bad) {
lp <- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0,
type = "source-required")
}
lp$ruled_out <- c(lp$ruled_out, bad)
lp
}
pkgplan_i_lp_failures <- function(lp) {
## 5. Can't install failed resolutions
failedconds <- function(wh) {
if (lp$pkgs$status[wh] != "FAILED") return()
lp <<- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0,
type = "ok-resolution")
lp$ruled_out <<- c(lp$ruled_out, wh)
}
lapply(seq_len(lp$num_candidates), failedconds)
lp
}
pkgplan_i_lp_ignore <- function(lp) {
ignored <- which(vlapply(lp$pkgs$params, is_true_param, "ignore"))
for (wh in ignored) {
lp <- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0,
type = "ignored-by-user")
}
lp$ruled_out <- c(lp$ruled_out, ignored)
lp
}
pkgplan_i_lp_platforms <- function(lp) {
## check if platform is good
badplatform <- function(wh) {
if (lp$pkgs$type[wh] %in% c("deps", "param")) return()
ok <- platform_is_ok(
lp$pkgs$platform[wh],
lp$config$get("platforms"),
lp$config$get("windows_archs")
)
if (!ok) {
lp <<- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0,
type = "matching-platform")
lp$ruled_out <<- c(lp$ruled_out, wh)
}
}
lapply(seq_len(lp$num_candidates), badplatform)
lp
}
pkgplan_i_lp_no_multiples <- function(lp) {
## 1. Each directly specified package exactly once.
## (We also add a dummy variable to catch errors.)
for (p in seq_along(lp$direct_packages)) {
pkg <- lp$direct_packages[p]
wh <- which(lp$pkgs$package == pkg)
lp <- pkgplan_i_lp_add_cond(
lp, c(wh, lp$num_candidates + p),
op = "==", type = "exactly-once")
}
## 2. Each non-direct package must be installed at most once
for (p in seq_along(lp$indirect_packages)) {
pkg <- lp$indirect_packages[p]
wh <- which(lp$pkgs$package == pkg)
lp <- pkgplan_i_lp_add_cond(lp, wh, op = "<=", type = "at-most-once")
}
lp
}
pkgplan_i_lp_rversion <- function(lp, rversion) {
rversion <- package_version(rversion)
pkgs <- lp$pkgs
num_candidates <- lp$num_candidates
ruled_out <- lp$ruled_out
base <- base_packages()
depconds <- function(wh) {
if (pkgs$status[wh] != "OK") return()
deps <- pkgs$deps[[wh]]
deps <- deps[deps$ref == "R", , drop = FALSE]
if (nrow(deps) == 0) return()
type <- NA
for (idx in seq_len(nrow(deps))) {
need <- deps$version[idx]
needrver <- paste0(deps$op[[idx]], " ", need)
switch(
deps$op[[idx]],
"<" = if (! rversion < need) type <- "new-rversion",
"<=" = if (! rversion <= need) type <- "new-rversion",
"==" = if (! rversion == need) type <- "different-rversion",
">=" = if (! rversion >= need) type <- "old-rversion",
">" = if (! rversion > need) type <- "old-rversion",
warning(paste0("Ignoring R version requirement: ", needrver))
)
# Enough to have one to rule out
if (!is.na(type)) break
}
if (!is.na(type)) {
lp <<- pkgplan_i_lp_add_cond(lp, wh, op = "==", rhs = 0,
type = type, note = needrver)
lp$ruled_out <<- c(lp$ruled_out, wh)
}
}
lapply(setdiff(seq_len(num_candidates), ruled_out), depconds)
lp
}
pkgplan_i_lp_satisfy_direct <- function(lp) {
## 3. Direct refs must be satisfied
satisfy <- function(wh) {
pkgname <- lp$pkgs$package[[wh]]
res <- lp$pkgs[wh, ]
others <- setdiff(which(lp$pkgs$package == pkgname), wh)
for (o in others) {
res2 <- lp$pkgs[o, ]
if (! isTRUE(satisfies_remote(res, res2))) {
lp <<- pkgplan_i_lp_add_cond(
lp, o, op = "==", rhs = 0, type = "satisfy-refs", note = wh)
}
}
}
direct <- setdiff(which(lp$pkgs$direct), lp$ruled_out)
lapply(direct, satisfy)
lp
}
## Order matters. By the time this is called, the failed resolutions
## are ruled out, and R version requirements are also checked.
## So we only work with the packages that are not ruled out, and select
## the latest version. This cannot be ruled out later, only because of
## version requirements, but then it is up to the user to solve this.
pkgplan_i_lp_latest_direct <- function(lp) {
pkgs <- lp$pkgs
# these have version requirements
vreq <- vlapply(
lp$pkgs$remote,
function(r) is.list(r) && !is.null(r$version) && r$version != ""
)
dirpkgs <- unique(lp$pkgs$package[lp$pkgs$direct & !vreq])
for (pkg in dirpkgs) {
cand <- which(
pkgs$package == pkg &
pkgs$type %in% c("cran", "bioc", "standard")
)
cand <- setdiff(cand, lp$ruled_out)
if (length(cand) == 0) next
vers <- package_version(pkgs$version[cand])
bad <- vers < max(vers)
for (wh in cand[bad]) {
lp <- pkgplan_i_lp_add_cond(
lp, wh, op = "==", rhs = 0, type = "direct-update"
)
}
lp$ruled_out <- c(lp$ruled_out, cand[bad])
}
lp
}
# CRAN's repo sometimes relies on selecting the latest version of
# a package, if multiple versions are available. (This is after considering
# R version requirements.) So we need to do the same, within repo.
# Otherwise pak/pkgdepends would select the first candidate, and while that
# always (?) OK for CRAN, the order is not the same in RSPM, apparently.
pkgplan_i_lp_latest_within_repo <- function(lp) {
nbr <- seq_len(nrow(lp$pkgs))
oid <- ifelse(nbr %in% lp$ruled_out, nbr, 0)
key <- paste0(
oid, "/", lp$pkgs$mirror, "/", lp$pkgs$repodir, "/",
lp$pkgs$platform, "/", lp$pkgs$ref
)
dups <- unique(key[duplicated(key)])
for (dupkey in dups) {
cand <- which (key == dupkey)
if (length(cand) == 0) next
vers <- package_version(lp$pkgs$version[cand])
bad <- vers < max(vers)
for (wh in cand[bad]) {
lp <- pkgplan_i_lp_add_cond(
lp, wh, op = "==", rhs = 0, type = "choose-latest"
)
}
lp$ruled_out <- c(lp$ruled_out, cand[bad])
}
lp
}
pkgplan_i_lp_prefer_installed <- function(lp) {
pkgs <- lp$pkgs
inst <- which(
pkgs$type == "installed" & ! seq_along(pkgs$type) %in% lp$ruled_out
)
for (i in inst) {
## If not a CRAN or BioC package, skip it
repotype <- pkgs$extra[[i]]$repotype
if (is.null(repotype) || ! repotype %in% c("cran", "bioc")) next
## Look for others with cran/bioc/standard type and same name & ver
package <- pkgs$package[i]
version <- pkgs$version[i]
ruledout <- which(pkgs$type %in% c("cran", "bioc", "standard") &
pkgs$package == package & pkgs$version == version)
lp$ruled_out <- c(lp$ruled_out, ruledout)
for (r in ruledout) {
lp <- pkgplan_i_lp_add_cond(lp, r, op = "==", rhs = 0,
type = "prefer-installed")
}
}
lp
}
# We only do this for source packages, because we already prefer new
# binaries, via `pkgplan_i_lp_prefer_new_binaries()`.
#
# We do this before we prefer binaries, because that rule will rule out
# any source package version that has a binary, and we want to compare all
# source versions here.
pkgplan_i_lp_deduplicate <- function(lp, config) {
pkgs <- lp$pkgs
whpp <- pkgs$status == "OK" & !is.na(pkgs$version)
pn <- unique(pkgs$package[whpp])
ruled_out <- integer()
for (p in pn) {
whp <- which(
whpp & pkgs$package == p &
pkgs$platform == "source" &
pkgs$type %in% c("cran", "bioc", "standard")
)
whp <- setdiff(whp, lp$ruled_out)
if (length(whp) <= 1) next
v <- package_version(pkgs$version[whp])
mv <- max(v)
best <- which(v == mv)[1]
for (i in whp[-best]) {
if (same_deps(pkgs$deps[[i]], pkgs$deps[[whp[best]]])) {
ruled_out <- c(ruled_out, i)
}
}
}
for (r in ruled_out) {
lp <- pkgplan_i_lp_add_cond(lp, r, op = "==", rhs = 0,
type = "choose-latest")
}
lp$ruled_out <- unique(c(lp$ruled_out, ruled_out))
lp
}
same_deps <- function(d1, d2) {
d1 <- d1[order(d1$package, d1$type), ]
rownames(d1) <- NULL
d2 <- d2[order(d2$package, d2$type), ]
rownames(d2) <- NULL
identical(d1, d2)
}
pkgplan_i_lp_prefer_binaries <- function(lp) {
pkgs <- lp$pkgs
str <- paste0(pkgs$type, "::", pkgs$package, "@", pkgs$version)
for (ustr in unique(str)) {
same <- which(ustr == str)
## We can't do this for other packages, because version is not
## exclusive for those
if (! pkgs$type[same[1]] %in% c("cran", "bioc", "standard")) next
## TODO: choose the right one for the current R version
selected <- setdiff(same[pkgs$platform[same] != "source"], lp$ruled_out)[1]
## No binary package, maybe there is RSPM. This is temporary,
## until we get proper RSPM support.
## It would be better to merge the download URLs in this case.
if (is.na(selected)) {
selected <- setdiff(same[grepl("__linux__", pkgs$mirror[same])], lp$ruled_out)[1]
}
## Same on Windows, to work around
## https://github.com/r-lib/pkgdepends/issues/276
## It would be better to merge the download URLs in this case.
if (is.na(selected)) {
selected <- setdiff(
same[grepl("^https://packagemanager[.]rstudio[.]com", pkgs$mirror[same])],
lp$ruled_out
)[1]
}
if (is.na(selected)) next
ruledout <- setdiff(same, selected)
lp$ruled_out <- c(lp$ruled_out, ruledout)
for (r in ruledout) {
lp <- pkgplan_i_lp_add_cond(lp, r, op = "==", rhs = 0,
type = "prefer-binary")
}
}
lp
}
pkgplan_i_lp_prefer_new_binaries <- function(lp) {
# We rule out older binaries if there is a new one available
# This is not always correct, but otherwise the solver will be slow.
# https://github.com/r-lib/pkgdepends/issues/276
# I tried adding a penalty to older versions, but that did not work.
pkgs <- lp$pkgs
whpp <- pkgs$status == "OK" & !is.na(pkgs$version)
pn <- unique(pkgs$package[whpp])
ruled_out <- integer()
for (p in pn) {
whp <- which(
whpp & pkgs$package == p &
pkgs$platform != "source" &
pkgs$type %in% c("cran", "bioc", "standard")
)
whp <- setdiff(whp, lp$ruled_out)
if (length(whp) == 0) next
v <- package_version(pkgs$version[whp])
ruled_out <- c(ruled_out, whp[v != max(v)])
}
for (r in ruled_out) {
lp <- pkgplan_i_lp_add_cond(lp, r, op = "==", rhs = 0,
type = "prefer-new-binary")
}
lp$ruled_out <- unique(c(lp$ruled_out, ruled_out))
lp
}
pkgplan_i_lp_dependencies <- function(lp, config) {
pkgs <- lp$pkgs
linkingto <- config$get("include_linkingto")
num_candidates <- lp$num_candidates
ruled_out <- lp$ruled_out
base <- base_packages()
ignored <- vlapply(pkgs$params, is_true_param, "ignore")
ignore_rver <- vcapply(pkgs$params, get_param_value, "ignore-before-r")
if (any(!is.na(ignore_rver))) {
ignore_rver[is.na(ignore_rver)] <- "0.0.0"
current <- min(lp$config$get("r_versions"))
ignored2 <- package_version(ignore_rver) > current
ignored <- ignored | ignored2
}
ignore_unavail <- vlapply(
pkgs$params,
is_true_param,
"ignore-unavailable"
)
failed <- pkgs$status == "FAILED"
ignored <- ignored | (ignore_unavail & failed)
# ignore packages with the wrong OS type
if (config$get("goal") == "install") {
os <- os_type()
bad <- which(!is.na(pkgs$os_type) & pkgs$os_type != os)
if (length(bad) > 0) ignored[bad] <- TRUE
}
soft_deps <- tolower(pkg_dep_types_soft())
## 4. Package dependencies must be satisfied
depconds <- function(wh) {
if (pkgs$status[wh] != "OK") return()
deps <- pkgs$deps[[wh]]
deptypes <- pkgs$dep_types[[wh]]
deps <- deps[deps$ref != "R", ]
deps <- deps[! deps$ref %in% base, ]
deps <- deps[tolower(deps$type) %in% tolower(deptypes), ]
if (!linkingto && pkgs$platform[wh] != "source") {
deps <- deps[tolower(deps$type) != "linkingto", ]
}
for (i in seq_len(nrow(deps))) {
depref <- deps$ref[i]
depver <- deps$version[i]
depop <- deps$op[i]
deppkg <- deps$package[i]
deptyp <- tolower(deps$type[i])
# candidates
res <- pkgs[match(depref, pkgs$ref), ]
cand <- which(pkgs$package == deppkg)
# if all candidates are ignored and the package is a soft
# dependency, then nothing to do
if (all(ignored[cand]) && deptyp %in% soft_deps) next
# good candidates
good_cand <- Filter(
x = cand,
function(c) {
candver <- pkgs$version[c]
pkgs$status[[c]] != "FAILED" &&
isTRUE(satisfies_remote(res, pkgs[c, ])) &&
(depver == "" || version_satisfies(candver, depop, depver))
})
bad_cand <- setdiff(cand, good_cand)
report <- c(
if (length(good_cand)) {
gc <- paste(pkgs$ref[good_cand], pkgs$version[good_cand])
paste0("version ", paste(gc, collapse = ", "))
},
if (length(bad_cand)) {
bc <- paste(pkgs$ref[bad_cand], pkgs$version[bad_cand])
paste0("but not ", paste(bc, collapse = ", "))
},
if (! length(cand)) "but no candidates"
)
txt <- sprintf(
"%s depends on %s: %s",
pkgs$ref[wh], depref, collapse(report, sep = ", ")
)
note <- list(wh = wh, ref = depref, cand = cand,
good_cand = good_cand, txt = txt, depop = depop,
depver = depver)
lp <<- pkgplan_i_lp_add_cond(
lp, c(wh, good_cand), "<=", rhs = 0,
coef = c(1, rep(-1, length(good_cand))),
type = "dependency", note = note
)
}
}
lapply(setdiff(seq_len(num_candidates), ruled_out), depconds)
lp
}
#' @export
print.pkgplan_lp_problem <- function(x, ...) {
cat(format(x, ...), sep = "\n")
}
format_cond <- function(x, cond) {
if (cond$type == "dependency") {
paste0(cond$note$txt)
} else if (cond$type == "satisfy-refs") {
ref <- x$pkgs$ref[cond$note]
cand <- x$pkgs$ref[cond$vars]
sprintf("`%s` is not satisfied by `%s`", ref, cand)
} else if (cond$type == "ok-resolution") {
ref <- x$pkgs$ref[cond$vars]
sprintf("`%s` resolution failed", ref)
} else if (cond$type == "source-required") {
ref <- x$pkgs$ref[cond$vars]
sprintf("a source package was required for `%s` by the user", ref)
} else if (cond$type == "ignored-by-user") {
ref <- x$pkgs$ref[cond$vars]
sprintf("`%s` explicitly ignored by user", ref)
} else if (cond$type == "matching-platform") {
ref <- x$pkgs$ref[cond$vars]
plat <- x$pkgs$platform[cond$vars]
sprintf("Platform `%s` does not match for `%s`", plat, ref)
} else if (cond$type == "old-rversion") {
ref <- x$pkgs$ref[cond$vars]
sprintf("`%s` needs a newer R version: %s", ref, cond$note)
} else if (cond$type == "new-rversion") {
ref <- x$pkgs$ref[cond$vars]
sprintf("`%s` needs an older R version: %s", ref, cond$node)
} else if (cond$type == "different-rversion") {
ref <- x$pkgs$ref[cond$vars]
sprintf("`%s` needs a different R version: %s", ref, cond$note)
} else if (cond$type == "direct-update") {
package <- x$pkgs$package[cond$vars]
sprintf("`%s` is direct, needs latest version", package)
} else if (cond$type == "choose-latest") {
ref <- x$pkgs$ref[cond$vars]
sprintf("`%s` has a newer version of the same platform", ref)
} else if (cond$type == "prefer-installed") {
ref <- x$pkgs$ref[cond$vars]
sprintf("installed is preferred for `%s`", ref)
} else if (cond$type == "prefer-binary") {
ref <- x$pkgs$ref[cond$vars]
sprintf("binary is preferred for `%s`", ref)
} else if (cond$type == "prefer-new-binary") {
ref <- x$pkgs$ref[cond$vars]
sprintf("newer binary is preferred for `%s`", ref)
} else if (cond$type == "source-requested") {
ref <- x$pkgs$ref[cond$vars]
sprintf("source package is requested for `%s`", ref)
} else if (cond$type == "exactly-once") {
ref <- na.omit(x$pkgs$package[cond$vars])[1]
sprintf("select %s exactly once", ref)
} else if (cond$type == "at-most-once") {
ref <- na.omit(x$pkgs$package[cond$vars])[1]
sprintf("select %s at most once", ref)
} else {
"Unknown constraint"
}
}
#' @export
format.pkgplan_lp_problem <- function(x, ...) {
result <- character()
push <- function(...) result <<- c(result, ...)
push("<pkgplan_lp_problem>")
push(sprintf("+ refs (%s):", x$num_candidates))
pn <- sort(x$pkgs$ref)
push(paste0(" - ", x$pkgs$ref))
if (length(x$conds)) {
push(sprintf("+ constraints (%s):", length(x$conds)))
conds <- drop_nulls(lapply(x$conds, format_cond, x = x))
push(paste0(" - ", conds))
} else {
push("+ no constraints")
}
result
}
pkgplan__solve_lp_problem <- function(self, private, problem) {
res <- pkgplan_i_solve_lp_problem(problem)
res
}
pkgplan_i_solve_lp_problem <- function(problem) {
"!DEBUG solving LP problem"
condmat <- matrix(0, nrow = length(problem$conds), ncol = problem$total)
for (i in seq_along(problem$conds)) {
cond <- problem$conds[[i]]
condmat[i, cond$vars] <- cond$coef
}
dir <- vcapply(problem$conds, "[[", "op")
rhs <- vapply(problem$conds, "[[", "rhs", FUN.VALUE = double(1))
lpSolve::lp(
"min",
problem$obj,
condmat,
dir,
rhs,
int.vec = seq_len(problem$total)
)
}
pkgplan_get_solution <- function(self, private) {
if (is.null(private$solution)) {
throw(pkg_error(
"You need to call the {.code $solve()} method first."
))
}
private$solution$result
}
#' Highlight version number changes
#'
#' @param old Character vector, old versions. `NA` for new installs.
#' @param new Character vector, the new versions to highlight.
#' @return Character vector, like `new`, but the change highlighted
#'
#' @noRd
highlight_version <- function(old, new) {
if (length(old) != length(new)) {
throw(pkg_error(
"Lengtgs of `old` and `new` must match",
i = msg_internal_error()
))
}
if (length(new) == 0) return(new)
wch <- !is.na(old) & old != new
oldv <- strsplit(old[wch], "(?=[.-])", perl = TRUE)
newv <- strsplit(new[wch], "(?=[.-])", perl = TRUE)
new[wch] <- as.character(mapply(oldv, newv, FUN = function(o, n) {
length(o) <- length(n) <- max(length(o), length(n))
idx <- which(is.na(o) | is.na(n) | (o != n & o != "." & o != "-"))[1]
n <- na.omit(n)
paste0(
if (idx > 1) paste(n[1:(idx-1)], collapse = ""),
if (idx <= length(n)) cli::style_bold(paste(n[idx:length(n)]), collapse = "")
)
}))
new
}
#' Highlight package list
#'
#' @param sol Solution data, data frame, with at least these columns:
#' `type`, `package`, `old_version`, `version`, `lib_status`,
#' `cache_status`, `platform`, `needscompilation`. Just what
#' `$get_solution()$data` returns, basically.
#' @return Character vector of highlighted list. All strings will have the
#' same (printed) length. Packages that do not involve installation will
#' have `NA` in the result.
#'
#' @noRd
highlight_package_list <- function(sol) {
arrow <- cli::symbol$arrow_right
ins <- sol$type != "installed" & sol$type != "deps"
sol <- sol[ins, ]
pkg <- ansi_align_width(cli::col_blue(sol$package))
old <- ansi_align_width(ifelse(is.na(sol$old_version), "", sol$old_version))
arr <- ansi_align_width(ifelse(is.na(sol$old_version), "", arrow))
new <- ansi_align_width(highlight_version(sol$old_version, sol$version))
bld <- sol$lib_status %in% c("new", "update") & sol$platform == "source"
cmp <- sol$lib_status %in% c("new", "update") &
!is.na(sol$needscompilation) & sol$needscompilation
dnl <- !is.na(sol$cache_status) & sol$cache_status == "miss"
gh <- sol$type == "github"
hash <- character(nrow(sol))
hash[gh] <- vcapply(sol$metadata[gh], function(x) x["RemoteSha"])
sysreqs <- highlight_sysreqs(sol$sysreqs_packages)
ann <- paste0(
ifelse(
bld, if (has_emoji()) emo_builder(sum(ins)) else emoji("builder"), ""),
ifelse(cmp, emoji("wrench"), ""),
ifelse(dnl, emoji("dl"), ""),
ifelse(
dnl & !is.na(sol$filesize),
paste0(" ", format_file_size(sol$filesize)),
""
),
ifelse(gh, paste0(" (GitHub: ", substr(hash, 1, 7), ")"), ""),
sysreqs
)
lns <- paste0(pkg, " ", old, " ", arr, " ", new, " ", ann)
ret <- rep(NA_character_, length(ins))
ret[ins] <- lns
key <- paste0(c(
if (any(bld)) paste(emoji("builder"), "build"),
if (any(cmp)) paste(emoji("wrench"), "compile"),
if (any(dnl)) paste(emoji("dl"), "download")
), collapse = " | ")
attr(ret, "key") <- if (key == "") "" else paste("[", key, "]")