[210_7] 实现 set-union! / set-intersection! / set-difference! / set-xor! 函数 #390

Author: wumoin

devel/210_7.md

@@ -13,6 +13,24 @@ bin/lint goldfish/srfi/srfi-113.scm
 bin/lint tests/goldfish/liii/set-test.scm
 ```
 
+## 2026/01/28 实现 set-union! / set-intersection! / set-difference! / set-xor! 函数
+### What
+在 (liii set) 模块中实现 set-union!、set-intersection!、set-difference!、set-xor! 函数，并在测试文件中新增相应的注释和测试用例。
+
+1. 在 goldfish/srfi/srfi-113.scm 中实现以上函数并添加到导出列表
+2. 在 goldfish/liii/set.scm 的导出列表中添加以上函数
+3. 在 tests/goldfish/liii/set-test.scm 中添加文档注释和测试用例
+
+### Why
+这些函数提供集合运算的可变版本，便于在原 set 上进行并集、交集、差集与对称差集计算，减少分配并保持元素来源规则。
+
+### How
+1. set-union! 按顺序并入集合，仅在 set1 中不存在时加入
+2. set-intersection! 保留同时出现在所有集合中的元素
+3. set-difference! 移除出现在其他集合中的元素
+4. set-xor! 移除交集元素，并加入只存在于 set2 的元素
+5. 在测试中覆盖多集合、元素来源与类型/比较器错误场景
+
 ## 2026/01/28 实现 set-union / set-intersection / set-difference / set-xor 函数
 ### What
 在 (liii set) 模块中实现 set-union、set-intersection、set-difference、set-xor 函数，并在测试文件中新增相应的注释和测试用例。

goldfish/liii/set.scm

@@ -26,6 +26,7 @@
           set-any? set-every? set-find set-count set-member set-search! set-map
           set-for-each set-fold set-filter set-filter! set-remove set-remove!
           set-partition set-partition! set-union set-intersection set-difference set-xor
+          set-union! set-intersection! set-difference! set-xor!
           set-adjoin set-adjoin! set-replace set-replace!
           set-delete set-delete! set-delete-all set-delete-all!)
 

goldfish/srfi/srfi-113.scm

@@ -35,6 +35,7 @@
           set-any? set-every? set-find set-count set-member set-search! set-map
           set-for-each set-fold set-filter set-filter! set-remove set-remove!
           set-partition set-partition! set-union set-intersection set-difference set-xor
+          set-union! set-intersection! set-difference! set-xor!
           set-adjoin set-adjoin! set-replace set-replace!
           set-delete set-delete! set-delete-all set-delete-all!)
   (begin
@@ -443,6 +444,71 @@
          ht2)
         result))
 
+    (define (set-union! set1 . sets)
+      (check-set set1)
+      (let ((ht1 (set-hash-table set1)))
+        (for-each
+         (lambda (s)
+           (check-set s)
+           (check-same-comparator set1 s)
+           (hash-table-for-each
+            (lambda (k v)
+              (unless (hash-table-contains? ht1 k)
+                (set-add! set1 k)))
+            (set-hash-table s)))
+         sets)
+        set1))
+
+    (define (set-intersection! set1 . sets)
+      (check-set set1)
+      (for-each
+       (lambda (s)
+         (check-set s)
+         (check-same-comparator set1 s))
+       sets)
+      (let ((ht1 (set-hash-table set1))
+            (other-hts (map set-hash-table sets)))
+        (define (all-contains? key)
+          (every (lambda (ht) (hash-table-contains? ht key)) other-hts))
+        (hash-table-for-each
+         (lambda (k v)
+           (unless (all-contains? k)
+             (hash-table-delete! ht1 k)))
+         ht1)
+        set1))
+
+    (define (set-difference! set1 . sets)
+      (check-set set1)
+      (for-each
+       (lambda (s)
+         (check-set s)
+         (check-same-comparator set1 s))
+       sets)
+      (let ((ht1 (set-hash-table set1))
+            (other-hts (map set-hash-table sets)))
+        (define (any-contains? key)
+          (any (lambda (ht) (hash-table-contains? ht key)) other-hts))
+        (hash-table-for-each
+         (lambda (k v)
+           (when (any-contains? k)
+             (hash-table-delete! ht1 k)))
+         ht1)
+        set1))
+
+    (define (set-xor! set1 set2)
+      (check-set set1)
+      (check-set set2)
+      (check-same-comparator set1 set2)
+      (let ((ht1 (set-hash-table set1))
+            (ht2 (set-hash-table set2)))
+        (hash-table-for-each
+         (lambda (k v)
+           (if (hash-table-contains? ht1 k)
+               (hash-table-delete! ht1 k)
+               (set-add! set1 k)))
+         ht2)
+        set1))
+
     (define (set-adjoin set . elements)
       (check-set set)
       (let ((new-set (set-copy set)))

tests/goldfish/liii/set-test.scm

@@ -1414,6 +1414,170 @@ set1, set2 : set
 (check-catch 'type-error (set-xor "not a set" s-1))
 (check-catch 'value-error (set-xor s-1 s-str-ci))
 
+#|
+set-union!
+将多个 set 并入 set1（可变操作）。
+
+语法
+----
+(set-union! set1 set2 ...)
+
+参数
+----
+set1, set2 ... : set
+参与并集的 set。
+
+返回值
+------
+返回修改后的 set1，元素来自它们首次出现的 set。
+|#
+
+;; 测试 set-union! 基本行为
+(define s-union!-1 (set 1 2 3))
+(define s-union!-result (set-union! s-union!-1 s-2-3-4 s-4-5))
+(check-true (eq? s-union!-result s-union!-1))
+(check (set-size s-union!-1) => 5)
+(check-true (set-contains? s-union!-1 1))
+(check-true (set-contains? s-union!-1 5))
+
+;; 测试元素来源（使用大小写不敏感比较器）
+(define s-union!-ci-1 (list->set-with-comparator string-ci-comparator '("Apple")))
+(define s-union!-ci-2 (list->set-with-comparator string-ci-comparator '("apple" "Banana")))
+(define s-union!-ci (set-union! s-union!-ci-1 s-union!-ci-2))
+(check-true (eq? s-union!-ci s-union!-ci-1))
+(check (set-member s-union!-ci "apple" 'not-found) => "Apple")
+(check (set-member s-union!-ci "banana" 'not-found) => "Banana")
+
+;; 测试类型与比较器错误
+(check-catch 'type-error (set-union! "not a set" s-1))
+(check-catch 'value-error (set-union! s-1 s-str-ci))
+
+#|
+set-intersection!
+就地更新 set1，使其成为多个 set 的交集。
+
+语法
+----
+(set-intersection! set1 set2 ...)
+
+参数
+----
+set1, set2 ... : set
+参与交集的 set。
+
+返回值
+------
+返回修改后的 set1，元素来自第一个 set。
+|#
+
+;; 测试 set-intersection! 基本行为
+(define s-inter!-1 (set 1 2 3 4))
+(define s-inter!-result (set-intersection! s-inter!-1 s-2-3-4))
+(check-true (eq? s-inter!-result s-inter!-1))
+(check (set-size s-inter!-1) => 3)
+(check-true (set-contains? s-inter!-1 2))
+(check-true (set-contains? s-inter!-1 3))
+(check-true (set-contains? s-inter!-1 4))
+
+;; 测试多集合交集
+(define s-inter!-2 (set 1 2 3 4))
+(set-intersection! s-inter!-2 s-2-3-4 (set 2 3))
+(check (set-size s-inter!-2) => 2)
+(check-true (set-contains? s-inter!-2 2))
+(check-true (set-contains? s-inter!-2 3))
+
+;; 测试元素来源（使用大小写不敏感比较器）
+(define s-inter!-ci-1 (list->set-with-comparator string-ci-comparator '("Apple" "Banana")))
+(define s-inter!-ci-2 (list->set-with-comparator string-ci-comparator '("apple" "Pear")))
+(set-intersection! s-inter!-ci-1 s-inter!-ci-2)
+(check (set-member s-inter!-ci-1 "apple" 'not-found) => "Apple")
+(check (set-size s-inter!-ci-1) => 1)
+
+;; 测试类型与比较器错误
+(check-catch 'type-error (set-intersection! "not a set" s-1))
+(check-catch 'value-error (set-intersection! s-1 s-str-ci))
+
+#|
+set-difference!
+就地更新 set1，使其成为与其余 set 的差集。
+
+语法
+----
+(set-difference! set1 set2 ...)
+
+参数
+----
+set1, set2 ... : set
+参与差集的 set。
+
+返回值
+------
+返回修改后的 set1，元素来自第一个 set。
+|#
+
+;; 测试 set-difference! 基本行为
+(define s-diff!-1 (set 1 2 3 4))
+(define s-diff!-result (set-difference! s-diff!-1 s-2-3-4))
+(check-true (eq? s-diff!-result s-diff!-1))
+(check (set-size s-diff!-1) => 1)
+(check-true (set-contains? s-diff!-1 1))
+(check-false (set-contains? s-diff!-1 2))
+
+;; 测试多集合差集
+(define s-diff!-2 (set 1 2 3 4 5))
+(set-difference! s-diff!-2 s-2-3-4 s-4-5)
+(check (set-size s-diff!-2) => 1)
+(check-true (set-contains? s-diff!-2 1))
+
+;; 测试元素来源（使用大小写不敏感比较器）
+(define s-diff!-ci-1 (list->set-with-comparator string-ci-comparator '("Apple" "Banana")))
+(define s-diff!-ci-2 (list->set-with-comparator string-ci-comparator '("apple")))
+(set-difference! s-diff!-ci-1 s-diff!-ci-2)
+(check (set-size s-diff!-ci-1) => 1)
+(check (set-member s-diff!-ci-1 "banana" 'not-found) => "Banana")
+
+;; 测试类型与比较器错误
+(check-catch 'type-error (set-difference! "not a set" s-1))
+(check-catch 'value-error (set-difference! s-1 s-str-ci))
+
+#|
+set-xor!
+就地更新 set1，使其成为与 set2 的对称差集。
+
+语法
+----
+(set-xor! set1 set2)
+
+参数
+----
+set1, set2 : set
+参与对称差集的 set。
+
+返回值
+------
+返回修改后的 set1。
+|#
+
+;; 测试 set-xor! 基本行为
+(define s-xor!-1 (set 1 2 3))
+(define s-xor!-result (set-xor! s-xor!-1 s-2-3-4))
+(check-true (eq? s-xor!-result s-xor!-1))
+(check (set-size s-xor!-1) => 2)
+(check-true (set-contains? s-xor!-1 1))
+(check-true (set-contains? s-xor!-1 4))
+
+;; 测试元素来源（使用大小写不敏感比较器）
+(define s-xor!-ci-1 (list->set-with-comparator string-ci-comparator '("Apple")))
+(define s-xor!-ci-2 (list->set-with-comparator string-ci-comparator '("apple" "Banana")))
+(set-xor! s-xor!-ci-1 s-xor!-ci-2)
+(check (set-size s-xor!-ci-1) => 1)
+(check (set-member s-xor!-ci-1 "banana" 'not-found) => "Banana")
+(check-false (set-contains? s-xor!-ci-1 "apple"))
+
+;; 测试类型与比较器错误
+(check-catch 'type-error (set-xor! "not a set" s-1))
+(check-catch 'value-error (set-xor! s-1 s-str-ci))
+
 #|
 set->list
 将 set 转换为列表（顺序未指定）。