Группировка элементов в списке по сумме в tcl

Question

у меня есть список

set num "20 10 40 50 25 15"

Я хочу, чтобы выходы были сгруппированы так, чтобы сумма каждой группы не превышала 60. В этом случае выдается:

{20 40} {10 50} {25 15}

Iнаписал следующий фрагмент

set num "20 10 40 50 25 15"
for {set i 0} {$i < 4} {incr i} {
    for {set j 0} {$j < 4} {incr j} {
        if {$i == $j} {continue}
        if {[expr  [lindex $num $i] + [lindex $num $j] ] == 60 } {
        puts "[lindex $num $i]  [lindex $num $j]"}
    }
}

Вывод:

20  40
10  50
40  20
50  10

Я пытаюсь удалить дубликаты и пытаюсь получить комбинацию, где сумма меньше 60

Answer 1

У меня сложилось впечатление, что это классическое задание курса, и в этом вопросе отсутствуют детали, относящиеся к обсуждению адекватного решения (например, любые ограничения по пространству или времени, дублированные элементы и т. Д.).

Хотя ответ Донала сам по себе полон, это лишь один из множества возможных снимков.Здесь более традиционная схема решения (при условии, что ищется решение на месте), включает в себя:

1. Запуск из отсортированного списка (который устанавливает общую сложность для Tcl [lsort]).
2. Выполните итерацию по этому отсортированному списку в двух направлениях, т. Е. От его головы и хвоста до их перекрытия.
3. Для каждой пары кандидатов текущей головы и хвоста решите, соблюдаются ли ограничения (например, предел парной суммы).В зависимости от решения, продолжайте двигаться вперед либо по указателю головы, либо по хвосту (используя incr).

Возможный скелет может выглядеть следующим образом:

proc pairwiseByCappedPairSum {list limit} {

    set list [lsort -integer $list]; # use -unique flag in case of duplicates
    set fromStart 0
    set fromEnd 0

    while {$fromStart < ([llength $list]-$fromEnd-1)} {
        set v1 [lindex $list $fromStart]
        set v2 [lindex $list end-$fromEnd]

        ## ENTER YOUR FRAGMENT HERE:
        ## -------------------------
        # if {...} {
        #   incr fromEnd
        # } else {
        #    puts [list $v1 ...]
        #    incr fromStart
        # }
    }
}

По завершении,и назвал так:

set num "20 10 40 50 25 15"
set limit 60
pairwiseByCappedPairSum $num $limit

он должен распечатать:

10 {15 20 25 40 50}
15 {20 25 40}
20 {25 40}

, что выглядит хорошо для меня.

Answer 2

Что вам нужно сделать, это написать процедуру, которая находит максимальную пару в списке, вторую процедуру, которая удаляет пару чисел из списка (при этом нужно быть осторожным с дубликатами), а затем собрать их вместе, чтобы сделать общееtask.

Разделение задач таким образом - одна из самых важных вещей, которую учат программисты.Чтобы понять это правильно, нужны практика и опыт.

proc findPair {list limit} {
    # Variables to hold our best matches so far
    set maxval -inf;  # Negative infinity is less than every other number
    set maxpair {}

    for {set idx1 0} {$idx1 < [llength $list]} {incr idx1} {
        set v1 [lindex $list $idx1]

        # Optimization: make idx2 always greater than idx1
        for {set idx2 [expr {$idx1 + 1}]} {$idx2 < [llength $list]} {incr idx2} {
            set v2 [lindex $list $idx2]
            set sum [expr {$v1 + $v2}]

            if {($sum <= $limit) && ($sum > $maxval)} {
                # Save what we've found as our new best choice
                set maxval $sum
                set maxpair [list $v1 $v2]
            }
        }
    }
    # This variable now has the first, best option...
    # ... or the empty list if we can't find anything that satisfies.
    return $maxpair
}

Возможно, вы захотите подумать, почему я удостоверяюсь, что $idx2 всегда больше, чем $idx1 (что происходит, если они наоборот;почему меня это не волнует?).

proc removePair {listvar pair} {
    # Make variable in caller also be a variable here; THIS IS CLEVER MAGIC
    upvar 1 $listvar list

    foreach value $pair {
        # Find where the value is
        set idx [lsearch -exact $list $value]
        # Remove the element at the $idx'th position
        set list [lreplace $list $idx $idx]
    }
}

Теперь, когда они у нас есть, мы можем решить общую проблему:

set numbers {20 10 40 50 25 15}
set limit 60

while {[llength $numbers] > 0} {
    set pair [findPair $numbers $limit]
    if {[llength $pair] > 0} {
        # We've found another pair. Great! Print it out
        puts "found pair: $pair"
        # NO ‘$’ in front of ‘numbers’; we are passing the VARIABLE NAME not the contents
        removePair numbers $pair
    } else {
        # No possible pairs left! This is a failure case
        puts "remaining unpairable numbers: $numbers"
        # Stop the search
        break
    }
}

Вывод этого:

found pair: 20 40
found pair: 10 50
found pair: 25 15

, который выглядит хорошо для меня.