Tcl 用交换差异替换相同的字符串？

要在Tcl中操作字符串，我们使用string命令

如果需要替换逗号：

set value { 10.00 }
puts [string map -nocase { . , }  $value]

# Return: 10,00

我们可以替换几个字符串：

set text "This is a replacement test text"
puts [string map -nocase { e E s S a A } $text]

# Returns: THIS IS A TEXT OF REPLACEMENT TEST

当然，我们可以用以下词语代替：

set text "This is a replacement test text"
puts [string map -nocase {test TEST a {second}} $text]

# Returns: This is the second replacement TEST text.

---

到目前为止还不错

但有一个不想沉默的问题是如何替换句子中多个相同的事件，为每个事件提供不同的替换？

例如： 我想要这个结果：10+02=12

=>10+02=12

我使用的是

lreverse

，以防替换字符串的长度与它替换的字符串的长度不同。如果从左到右进行替换，索引将关闭

***=

用于避免对匹配字符串中的通配符进行特殊处理

当然，如果要处理出现次数与提供的替换次数不匹配的情况，事情会变得复杂得多。如果要替换多个不同的字符串，则更是如此

---

此版本处理上述复杂问题：

proc seqmap {map str} {
    # Transform the map into a dict with each key containing a list of replacements
    set mapdict {}
    foreach {s r} $map {dict lappend mapdict $s $r}
    # Build a map where each key maps to a unique tag
    # At the same time build a dict that maps our tags to the replacements
    # First map the chosen tag character in case it is present in the string
    set newmap {@ @00}
    set mapdict [dict map {s r} $mapdict {
        lappend newmap $s [set s [format @%02d [incr num]]]
        set r
    }]
    # Add the tag character to the dict so it can be mapped back
    dict set mapdict @00 @
    # Map the tags into the string
    set rc [string map $newmap $str]
    # Locate the positions where the tags ended up
    set match [regexp -all -indices -inline {@\d\d} $rc]
    # Create a list of replacements matching the tags
    set replace [lmap l $match {
        # Extract the tag
        set t [string range $rc {*}$l]
        # Obtain a replacement for this tag
        set s [lassign [dict get $mapdict $t] r]
        # Return the used replacement to the end of the list
        dict set mapdict $t [linsert $s end $r]
        # Add the replacement to the list
        set r
    }]
    # Walk the two lists in reverse order, replacing the tags with the selected replacements
    foreach l [lreverse $match] r [lreverse $replace] {
        set rc [string replace $rc {*}$l $r]
    }
    # Done
    return $rc
}

调用它就像调用

字符串映射

，因此使用键值映射和要对其执行替换的字符串。任何重复的键都指定要替换每次出现的键的后续值。当列表用尽时，它将从头开始

所以

把[seqmap{:+：=：*}10:02:12]

=>10+02=12

和

放置[seqmap{:+：=}10:02:12:04:16]

=>10+02=12+04=16

---

如前所述，该命令最多可以处理99个唯一键。但是如果需要更多，它可以很容易地更新。

很酷，我正在查看您答案的源代码。。。听起来不错。在8.7中做这件事要容易得多，它有

regsub-command

。

proc seqmap {str match args} {
    set rc $str
    foreach l [lreverse [regexp -all -indices -inline ***=$match $str]] \
      replacement [lreverse $args] {
        set rc [string replace $rc {*}$l $replacement]
    }
    return $rc
}

seqmap 10:02:12 : { + } { = }

proc seqmap {map str} {
    # Transform the map into a dict with each key containing a list of replacements
    set mapdict {}
    foreach {s r} $map {dict lappend mapdict $s $r}
    # Build a map where each key maps to a unique tag
    # At the same time build a dict that maps our tags to the replacements
    # First map the chosen tag character in case it is present in the string
    set newmap {@ @00}
    set mapdict [dict map {s r} $mapdict {
        lappend newmap $s [set s [format @%02d [incr num]]]
        set r
    }]
    # Add the tag character to the dict so it can be mapped back
    dict set mapdict @00 @
    # Map the tags into the string
    set rc [string map $newmap $str]
    # Locate the positions where the tags ended up
    set match [regexp -all -indices -inline {@\d\d} $rc]
    # Create a list of replacements matching the tags
    set replace [lmap l $match {
        # Extract the tag
        set t [string range $rc {*}$l]
        # Obtain a replacement for this tag
        set s [lassign [dict get $mapdict $t] r]
        # Return the used replacement to the end of the list
        dict set mapdict $t [linsert $s end $r]
        # Add the replacement to the list
        set r
    }]
    # Walk the two lists in reverse order, replacing the tags with the selected replacements
    foreach l [lreverse $match] r [lreverse $replace] {
        set rc [string replace $rc {*}$l $r]
    }
    # Done
    return $rc
}