diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml new file mode 100644 index 0000000..c9d3368 --- /dev/null +++ b/.github/workflows/CI.yml @@ -0,0 +1,32 @@ +name: CI + +env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + +on: + push: + branches: [master] + pull_request: + branches: [master] + workflow_dispatch: + +jobs: + build: + strategy: + matrix: + os: [macos-latest, ubuntu-latest, windows-latest] + smalltalk: [Pharo64-14, Pharo64-13, Pharo64-12, Pharo64-11, Pharo64-10] + + runs-on: ${{ matrix.os }} + name: ${{ matrix.smalltalk }} on ${{ matrix.os }} + + steps: + - uses: actions/checkout@v3 + - name: Setup SmalltalkCI + uses: hpi-swa/setup-smalltalkCI@v1 + with: + smalltalk-version: ${{ matrix.smalltalk }} + - name: Load and Test + run: smalltalkci -s ${{ matrix.smalltalk }} + shell: bash + timeout-minutes: 15 \ No newline at end of file diff --git a/.github/workflows/matrix.yml b/.github/workflows/matrix.yml deleted file mode 100644 index 4884745..0000000 --- a/.github/workflows/matrix.yml +++ /dev/null @@ -1,31 +0,0 @@ -name: matrix - -on: - push: - branches: [ master ] - pull_request: - branches: [ master ] - - # Allows you to run this workflow manually from the Actions tab - workflow_dispatch: - -# A workflow run is made up of one or more jobs that can run sequentially or in parallel -jobs: - build: - strategy: - matrix: - os: [ macos-latest, ubuntu-latest ] - smalltalk: [ Pharo64-8.0, Pharo64-7.0 ] - runs-on: ${{ matrix.os }} - name: ${{ matrix.smalltalk }} on ${{ matrix.os }} - steps: - - uses: actions/checkout@v2 - - name: Setup smalltalkCI - uses: hpi-swa/setup-smalltalkCI@v1 - with: - smalltalk-version: ${{ matrix.smalltalk }} - - name: Load Image and Run Tests - run: smalltalkci -s ${{ matrix.smalltalk }} - env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} - timeout-minutes: 15 diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index be200f0..0000000 --- a/.travis.yml +++ /dev/null @@ -1,13 +0,0 @@ -language: smalltalk -sudo: false - -# Select operating system(s) -os: - - linux - - osx - -# Select compatible Smalltalk image(s) -smalltalk: - - Pharo-7.0 - - Pharo64-8.0 - - Pharo64-7.0 diff --git a/README.md b/README.md index e43b275..de4f78a 100644 --- a/README.md +++ b/README.md @@ -1,55 +1,110 @@ # Containers-KeyedTree -An implementation of KeyedTree +A hierarchical data structure that provides path-based access to nested elements with dictionary-like functionality. Perfect for configuration management, file system structures & hierarchical data organization. -[![Build Status](https://travis-ci.com/Ducasse/Containers-KeyedTree.svg?branch=master)](https://travis-ci.com/Ducasse/Containers-KeyedTree) -[![Coverage Status](https://coveralls.io/repos/github//Ducasse/Containers-KeyedTree/badge.svg?branch=master)](https://coveralls.io/github//Ducasse/Containers-KeyedTree?branch=master) -[![License](https://img.shields.io/badge/license-MIT-blue.svg)]() -[![Pharo version](https://img.shields.io/badge/Pharo-7.0-%23aac9ff.svg)](https://pharo.org/download) -[![Pharo version](https://img.shields.io/badge/Pharo-8.0-%23aac9ff.svg)](https://pharo.org/download) - +![Pharo Version](https://img.shields.io/badge/Pharo-10+-blue) +[![License: MIT](https://img.shields.io/badge/License-MIT-green.svg)](LICENSE) +## What is a KeyedTree? +A KeyedTree is a specialized dictionary that allows nested structures where values can be accessed through path-based keys. Each node can contain both direct values and subtrees, enabling hierarchical data organization similar to file systems or nested configurations. +## Loading +The following script installs Containers-KeyedTree in Pharo. -## Example -To have an overview of the features this datastructure provide, have a look at the following code snippet (extracted from a unit test): +```smalltalk +Metacello new + baseline: 'ContainersKeyedTree'; + repository: 'github://pharo-containers/Containers-KeyedTree/src'; + load. +``` -```st -firstLevelOneSubTree := CTKeyedTree new. -firstLevelOneSubTree - at: #two put: 'One-Two'; - at: #three put: 'One-Three'. - -tree := CTKeyedTree new. -tree - at: 1 put: firstLevelOneSubTree; - at: 2 put: 'Two'. - -self assert: (tree atPath: #(1)) equals: firstLevelOneSubTree. -self assert: (tree atPath: #(1 two)) equals: 'One-Two'. -self assert: (tree atPath: #(1 three)) equals: 'One-Three'. -self assert: (tree atPath: #(2)) equals: 'Two'. -self should: [ tree atPath: #(2 4) ] raise: self defaultTestError. -self should: [ tree atPath: #(1 two three) ] raise: self defaultTestError. -self should: [ tree atPath: #(3) ] raise: self defaultTestError +## If you want to depend on it +Add the following code to your Metacello baseline or configuration: + +```smalltalk +spec + baseline: 'ContainersKeyedTree' + with: [ spec repository: 'github://pharo-containers/Containers-KeyedTree/src' ]. ``` -## Loading +## Why use Containers-KeyedTree? -The following script installs Containers-Stack in Pharo. +KeyedTrees solve the problem of **organizing hierarchical data with efficient path-based access**. Perfect for configuration files, menu systems, and any data that naturally forms a tree structure. -```st -Metacello new - baseline: 'ContainersKeyedTree'; - repository: 'github://pharo-containers/Containers-KeyedTree:v1.0/src'; - load. -``` +### Key Benefits +- **Hierarchical Organization**: Natural tree structure for nested data +- **Path-based Access**: Access deep elements with simple path arrays +- **Flexible Values**: Store any object type at any level +- **Merge Capability**: Combine trees intelligently +- **Dictionary Compatibility**: Inherits from Dictionary for familiar API + +## Basic Usage + +```smalltalk +"Create a hierarchical structure" +tree := CTKeyedTree new. -## If you want to depend on it +"Add simple values" +tree at: #name put: 'MyApp'. +tree at: #version put: '1.0.0'. -Add the following code to your Metacello baseline or configuration +"Create nested structures" +config := CTKeyedTree new. +config at: #host put: 'localhost'. +config at: #port put: 8080. +tree at: #server put: config. +"Access with paths" +tree atPath: #(server host). "=> 'localhost'" +tree atPath: #(server port). "=> 8080" +tree atPath: #(version). "=> '1.0.0'" ``` -spec - baseline: 'ContainersKeyedTree' - with: [ spec repository: 'github://pharo-containers/Containers-KeyedTree:v1.0/src' ] + +## Real-World Use Cases + +```smalltalk +"Build a hierarchical menu structure for GUI Applications" +mainMenu := CTKeyedTree new. + +"File menu" +fileMenu := CTKeyedTree new + at: #new put: 'Create New Document'; + at: #open put: 'Open Document'; + at: #recent put: (CTKeyedTree new + at: #doc1 put: '/path/to/recent1.txt'; + at: #doc2 put: '/path/to/recent2.txt'; + yourself); + at: #save put: 'Save Document'; + at: #exit put: 'Exit Application'; + yourself. + +"Edit menu" +editMenu := CTKeyedTree new + at: #undo put: 'Undo Last Action'; + at: #redo put: 'Redo Last Action'; + at: #copy put: 'Copy Selection'; + at: #paste put: 'Paste Content'; + yourself. + +"Tools menu with nested submenus" +toolsMenu := CTKeyedTree new + at: #preferences put: (CTKeyedTree new + at: #general put: 'General Settings'; + at: #appearance put: 'Theme & UI'; + at: #shortcuts put: 'Keyboard Shortcuts'; + yourself); + at: #plugins put: 'Manage Plugins'; + yourself. + +mainMenu + at: #file put: fileMenu; + at: #edit put: editMenu; + at: #tools put: toolsMenu. + +"Access menu items by path" +newAction := mainMenu atPath: #(file new). "=> 'Create New Document'" +recentDoc := mainMenu atPath: #(file recent doc1). "=> '/path/to/recent1.txt'" +themeSettings := mainMenu atPath: #(tools preferences appearance). "=> 'Theme & UI'" ``` + +## Contributing +This is part of the Pharo Containers project. Feel free to contribute by implementing additional methods, improving tests, or enhancing documentation. \ No newline at end of file diff --git a/src/BaselineOfContainersKeyedTree/BaselineOfContainersKeyedTree.class.st b/src/BaselineOfContainersKeyedTree/BaselineOfContainersKeyedTree.class.st index 0d7bf47..aec4691 100644 --- a/src/BaselineOfContainersKeyedTree/BaselineOfContainersKeyedTree.class.st +++ b/src/BaselineOfContainersKeyedTree/BaselineOfContainersKeyedTree.class.st @@ -1,14 +1,17 @@ Class { - #name : #BaselineOfContainersKeyedTree, - #superclass : #BaselineOf, - #category : #BaselineOfContainersKeyedTree + #name : 'BaselineOfContainersKeyedTree', + #superclass : 'BaselineOf', + #category : 'BaselineOfContainersKeyedTree', + #package : 'BaselineOfContainersKeyedTree' } -{ #category : #baselines } +{ #category : 'baselines' } BaselineOfContainersKeyedTree >> baseline: spec [ + - spec for: #pharo do: [ - spec package: 'Containers-KeyedTree'. - spec package: 'Containers-KeyedTree-Tests' with: [ spec requires: #('Containers-KeyedTree') ] - ] -] \ No newline at end of file + spec for: #common do: [ + spec package: 'Containers-KeyedTree'. + spec + package: 'Containers-KeyedTree-Tests' + with: [ spec requires: #( 'Containers-KeyedTree' ) ] ] +] diff --git a/src/BaselineOfContainersKeyedTree/package.st b/src/BaselineOfContainersKeyedTree/package.st index 41276dc..d922b59 100644 --- a/src/BaselineOfContainersKeyedTree/package.st +++ b/src/BaselineOfContainersKeyedTree/package.st @@ -1 +1 @@ -Package { #name : #BaselineOfContainersKeyedTree } +Package { #name : 'BaselineOfContainersKeyedTree' } diff --git a/src/Containers-KeyedTree-Tests/CTKeyedTreeTest.class.st b/src/Containers-KeyedTree-Tests/CTKeyedTreeTest.class.st index ff7451c..55aac9f 100644 --- a/src/Containers-KeyedTree-Tests/CTKeyedTreeTest.class.st +++ b/src/Containers-KeyedTree-Tests/CTKeyedTreeTest.class.st @@ -1,38 +1,45 @@ " -SUnit tests for CTKeyedTree +I test the KeyedTree implementation (CTKeyedTree). + +I verify correctness of all tree operations including path-based access, tree merging, collection protocol methods, and edge cases like empty trees, invalid paths, and complex hierarchical structures. + +I ensure the KeyedTree maintains proper hierarchical structure and handles various data types correctly. " Class { - #name : #CTKeyedTreeTest, - #superclass : #TestCase, + #name : 'CTKeyedTreeTest', + #superclass : 'TestCase', #instVars : [ 'tree', 'firstLevelOneSubTree' ], - #category : 'Containers-KeyedTree-Tests' + #category : 'Containers-KeyedTree-Tests', + #package : 'Containers-KeyedTree-Tests' } -{ #category : #running } +{ #category : 'running' } CTKeyedTreeTest >> setUp [ + super setUp. firstLevelOneSubTree := CTKeyedTree new - at: #two put: 'One-Two'; - at: #three put: 'One-Three'; - yourself. + at: #two put: 'One-Two'; + at: #three put: 'One-Three'; + yourself. tree := CTKeyedTree new - at: 1 put: firstLevelOneSubTree; - at: 2 put: 'Two'; - yourself + at: 1 put: firstLevelOneSubTree; + at: 2 put: 'Two'; + yourself ] -{ #category : #'tests - operation' } +{ #category : 'helpers' } CTKeyedTreeTest >> t13 [ + ^ CTKeyedTree new at: 1 put: '1-3-1'; at: 2 put: '1-3-2'; yourself ] -{ #category : #'tests - operation' } +{ #category : 'helpers' } CTKeyedTreeTest >> t2 [ ^ CTKeyedTree new at: 1 put: '1-1'; @@ -41,16 +48,20 @@ CTKeyedTreeTest >> t2 [ yourself ] -{ #category : #'tests - operation' } +{ #category : 'helpers' } CTKeyedTreeTest >> t2AB [ + ^ CTKeyedTree new - at: 1 put: '1-1'; - at: 2 put: '1-2'; - at: 3 put: (self tAB); - yourself + at: 1 put: '1-1'; + at: 2 put: '1-2'; + at: 3 put: (CTKeyedTree new + at: #A put: '1-3-1'; + at: #B put: '1-3-2'; + yourself); + yourself ] -{ #category : #'tests - operation' } +{ #category : 'helpers' } CTKeyedTreeTest >> tAB [ ^ CTKeyedTree new at: #A put: '1-3-1'; @@ -58,40 +69,72 @@ CTKeyedTreeTest >> tAB [ yourself ] -{ #category : #'tests - operation' } +{ #category : 'tests' } +CTKeyedTreeTest >> testAddMultipleElements [ + + tree := CTKeyedTree new. + tree at: #key1 put: 'value1'. + tree at: #key2 put: 'value2'. + tree at: #key3 put: 'value3'. + + self assert: tree size equals: 3 +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testAddSingleElement [ + + | emptyTree | + emptyTree := CTKeyedTree new. + emptyTree at: #test put: 'value'. + + self deny: emptyTree isEmpty. + self assert: emptyTree size equals: 1 +] + +{ #category : 'tests' } CTKeyedTreeTest >> testAllKeys [ + self assert: self t13 allKeys asArray equals: #(1 2). self assert: self t2AB allKeys asArray equals: #(1 2 3 #A #B). ] -{ #category : #'tests - operation' } -CTKeyedTreeTest >> testAllKeysEmptyTree [ - | emptyTree | - emptyTree := CTKeyedTree new. - self assert: emptyTree allKeys isEmpty. +{ #category : 'tests' } +CTKeyedTreeTest >> testAllPaths [ + + | paths | + paths := self t2AB allPaths. + self assert: paths size equals: 4. + self assert: (paths includes: #(1)). + self assert: (paths includes: #(2)). + self assert: (paths includes: #(3 #A)). + self assert: (paths includes: #(3 #B)). ] -{ #category : #'tests - at' } +{ #category : 'tests' } +CTKeyedTreeTest >> testAsArray [ + + | result | + result := self t13 asArray. + self assert: result size equals: 2. + self assert: (result includes: '1-3-1'). + self assert: (result includes: '1-3-2'). +] + +{ #category : 'tests' } CTKeyedTreeTest >> testAtPath [ + self assert: (tree atPath: #(1)) equals: firstLevelOneSubTree. self assert: (tree atPath: #(1 two)) equals: 'One-Two'. self assert: (tree atPath: #(1 three)) equals: 'One-Three'. self assert: (tree atPath: #(2)) equals: 'Two'. - self should: [ tree atPath: #(2 4) ] raise: self defaultTestError. - self should: [ tree atPath: #(1 two three) ] raise: self defaultTestError. - self should: [ tree atPath: #(3) ] raise: self defaultTestError. + + self should: [ tree atPath: #(2 4) ] raise: KeyNotFound. + self should: [ tree atPath: #(1 two three) ] raise: KeyNotFound. + self should: [ tree atPath: #(3) ] raise: KeyNotFound. ] -{ #category : #'tests - at' } -CTKeyedTreeTest >> testAtPathEmpty [ - | emptyTree | - emptyTree := CTKeyedTree new. - self should: [ emptyTree atPath: #(1) ] raise: self defaultTestError. -] - -{ #category : #tests } +{ #category : 'tests' } CTKeyedTreeTest >> testAtPathIfAbsent [ - "Test accessing elements using a path with an ifAbsent: block." self assert: (tree atPath: #(1) ifAbsent: [ #missing ]) equals: firstLevelOneSubTree. self assert: (tree atPath: #(1 two) ifAbsent: [ #missing ]) equals: 'One-Two'. @@ -102,8 +145,9 @@ CTKeyedTreeTest >> testAtPathIfAbsent [ self assert: (tree atPath: #(3) ifAbsent: [ #missing ]) equals: #missing ] -{ #category : #'tests - at' } +{ #category : 'tests' } CTKeyedTreeTest >> testAtPathIfAbsentPut [ + self assert: (tree atPath: #(1) ifAbsentPut: [ #new ]) equals: firstLevelOneSubTree. self assert: (tree atPath: #(1 two) ifAbsentPut: [ #new ]) equals: 'One-Two'. self assert: (tree atPath: #(1 three) ifAbsentPut: [ #new ]) equals: 'One-Three'. @@ -112,43 +156,125 @@ CTKeyedTreeTest >> testAtPathIfAbsentPut [ self assert: (tree atPath: #(1 four one)) equals: #anotherNew. self assert: (tree atPath: #(3) ifAbsentPut: [ #yetAnotherNew ]) equals: #yetAnotherNew. self assert: (tree atPath: #(3)) equals: #yetAnotherNew. - self should: [ tree atPath: #(2 4) ifAbsentPut: [ #new ] ] raise: self defaultTestError. + + self should: [ tree atPath: #(2 4) ifAbsentPut: [ #new ] ] raise: MessageNotUnderstood. ] -{ #category : #'tests - at' } +{ #category : 'tests' } CTKeyedTreeTest >> testAtPathPut [ - self assert: (tree atPath: #(1 two) put: #new) equals: #new. - self assert: (tree atPath: #(1 two)) equals: #new. - self assert: (tree atPath: #(1 three) put: (firstLevelOneSubTree := CTKeyedTree new)) equals: firstLevelOneSubTree. - self assert: (tree atPath: #(1 three $1) put: #anotherNew) equals: #anotherNew. - self assert: (tree atPath: #(1 three $1)) equals: #anotherNew. - self assert: (tree atPath: #(1 four one) put: #anotherNew) equals: #anotherNew. - self assert: (tree atPath: #(1 four one)) equals: #anotherNew. - self should: [ tree atPath: #(2 4) put: [ #new ] ] raise: self defaultTestError. + + self assert: (tree atPath: #( 1 two ) put: #new) equals: #new. + self assert: (tree atPath: #( 1 two )) equals: #new. + self + assert: (tree atPath: #( 1 three ) put: CTKeyedTree new) class + equals: CTKeyedTree. + self + assert: (tree atPath: #( 1 four one ) put: #anotherNew) + equals: #anotherNew. + self assert: (tree atPath: #( 1 four one )) equals: #anotherNew. + + self should: [ tree atPath: #(2 4) put: #new ] raise: KeyNotFound. + ] -{ #category : #'tests - copying' } +{ #category : 'tests' } +CTKeyedTreeTest >> testCollectionMethods [ + + | doubled selected found | + tree at: #color put: 'red'. + tree at: #number put: 42. + + doubled := self t13 collect: [ :value | value, '-modified' ]. + self assert: (doubled at: 1) equals: '1-3-1-modified'. + self assert: (doubled at: 2) equals: '1-3-2-modified'. + + selected := tree select: [ :value | value isString ]. + self assert: (selected at: #color) equals: 'red'. + self assert: (selected at: 2) equals: 'Two'. + self deny: (selected includesKey: #number). + + found := tree detect: [ :value | value = 'red' ] ifNone: [ nil ]. + self assert: found equals: 'red'. + + self assert: (tree anySatisfy: [ :value | value = 'red' ]). + self deny: (tree anySatisfy: [ :value | value = 'nonexistent' ]) +] + +{ #category : 'tests' } CTKeyedTreeTest >> testCopy [ - | c t2 t3 | - tree := CTKeyedTree new - at: 1 put: (t2 := CTKeyedTree new - at: #two put: 'One-Two'; - at: #three put: 'One-Three'; - at: #four put: (t3 := CTKeyedTree new); - yourself); - at: 2 put: 'Two'; - yourself. + + | c | c := tree copy. self assert: c = tree. self deny: c == tree. - self assert: (c at: 1) = t2. - self deny: (c at: 1) == t2. - self assert: (c atPath: #(1 four)) = t3. - self deny: (c atPath: #(1 four)) == t3. + self assert: (c at: 1) equals: (tree at: 1). + self deny: (c at: 1) == (tree at: 1). + + c at: #new put: 'newValue'. + self deny: (tree includesKey: #new). + self assert: (c includesKey: #new) ] -{ #category : #'tests - operation' } +{ #category : 'tests' } +CTKeyedTreeTest >> testDepth [ + + | emptyTree simpleTree deepTree | + emptyTree := CTKeyedTree new. + self assert: emptyTree depth equals: 0. + + simpleTree := CTKeyedTree new at: #key put: 'value'; yourself. + self assert: simpleTree depth equals: 1. + + deepTree := CTKeyedTree new + at: #level1 put: (CTKeyedTree new + at: #level2 put: (CTKeyedTree new + at: #level3 put: 'deep value'; + yourself); + yourself); + yourself. + self assert: deepTree depth equals: 3. +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testDoMethod [ + + | result | + result := OrderedCollection new. + self t13 do: [ :value | result add: value ]. + + self assert: result size equals: 2. + self assert: (result includes: '1-3-1'). + self assert: (result includes: '1-3-2'). +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testEmpty [ + + | emptyTree | + emptyTree := CTKeyedTree new. + self assert: emptyTree isEmpty. + self assert: emptyTree size equals: 0. +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testEmptyTreeOperations [ + + | emptyTree result | + emptyTree := CTKeyedTree new. + self assert: emptyTree isEmpty. + self assert: emptyTree allKeys isEmpty. + self assert: emptyTree subtrees isEmpty. + self deny: (emptyTree includesPath: #(nonexistent)). + + result := emptyTree collect: [ :value | value ]. + self assert: result isEmpty. + + self deny: (emptyTree anySatisfy: [ :value | true ]) +] + +{ #category : 'tests' } CTKeyedTreeTest >> testFormattedText [ + self assert: self t13 formattedText equals: '1 : ''1-3-1'' 2 : ''1-3-2'' @@ -162,81 +288,105 @@ CTKeyedTreeTest >> testFormattedText [ '. ] -{ #category : #'tests - operation' } +{ #category : 'tests' } +CTKeyedTreeTest >> testHasPath [ + + self assert: (tree hasPath: #(1)). + self assert: (tree hasPath: #(1 two)). + self assert: (tree hasPath: #(2)). + self deny: (tree hasPath: #(3)). + self deny: (tree hasPath: #(1 four)). + self deny: (tree hasPath: #(2 nested)). +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testIncludesPath [ + + self assert: (tree includesPath: #(1 two)). + self deny: (tree includesPath: #(nonexistent path)). +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testLeafValues [ + + | leaves | + leaves := self t2AB leafValues. + self assert: leaves size equals: 4. + self assert: (leaves includes: '1-1'). + self assert: (leaves includes: '1-2'). + self assert: (leaves includes: '1-3-1'). + self assert: (leaves includes: '1-3-2'). +] + +{ #category : 'tests' } CTKeyedTreeTest >> testMerge [ - | t1 t2 t13 m subT1 subt11 wrapSubt11 | - t13 := self t13. - subT1 := self t2. - subt11 := CTKeyedTree new - at: 1 put: '1-1-1'; - at: 2 put: '1-1-2'; - yourself. - wrapSubt11 := CTKeyedTree new - at: 1 put: subt11; - at: 2 put: '1-2*'; - yourself. + + | t1 t2 m | t1 := CTKeyedTree new - at: 1 put: subT1; - at: 2 put: '2'; + at: 1 put: 'original'; + at: #shared put: (CTKeyedTree new + at: #key1 put: 'value1'; + at: #key2 put: 'value2'; + yourself); yourself. + t2 := CTKeyedTree new - at: 1 put: wrapSubt11; - at: 3 put: '3'; - yourself. - m := t1 merge: t2. - self assert: (m at: 2) equals: '2'. - self assert: (m at: 3) equals: '3'. - self assert: (m atPath: #(1 2)) equals: '1-2*'. - self assert: (m atPath: #(1 1 1)) equals: '1-1-1'. - self assert: (m atPath: #(1 1 2)) equals: '1-1-2'. - self assert: (m atPath: #(1 3 1)) equals: '1-3-1'. - self assert: (m atPath: #(1 3 2)) equals: '1-3-2'. -] - -{ #category : #'tests - copying' } -CTKeyedTreeTest >> testPostCopy [ - | original copy subTree | - original := CTKeyedTree new - at: 1 put: (subTree := CTKeyedTree new at: #a put: 'A'; yourself); - at: 2 put: 'B'; + at: 2 put: 'new'; + at: #shared put: (CTKeyedTree new + at: #key2 put: 'updated'; + at: #key3 put: 'value3'; + yourself); yourself. - copy := original copy. - "Modify the copy and ensure the original is unaffected" - (copy at: 1) at: #a put: 'Modified'. - self assert: (copy atPath: #(1 a)) equals: 'Modified'. - self assert: (original atPath: #(1 a)) equals: 'A'. - self deny: (copy at: 1) == subTree. + + m := t1 copy merge: t2. + self assert: (m at: 1) equals: 'original'. + self assert: (m at: 2) equals: 'new'. + self assert: (m atPath: #(shared key1)) equals: 'value1'. + self assert: (m atPath: #(shared key2)) equals: 'updated'. + self assert: (m atPath: #(shared key3)) equals: 'value3'. ] -{ #category : #tests } -CTKeyedTreeTest >> testPutFormattedTextOnLevelIndentString [ - "Test formatted text output with a custom indent string." +{ #category : 'tests' } +CTKeyedTreeTest >> testNodeCount [ - | stream | - stream := String new writeStream. - tree putFormattedTextOn: stream level: 1 indentString: '>>'. - self - assert: stream contents - equals: - '>>1 ->> #three : ''One-Three'' ->> #two : ''One-Two'' ->>2 : ''Two'' -' + | emptyTree | + emptyTree := CTKeyedTree new. + self assert: emptyTree nodeCount equals: 0. + + self assert: self t13 nodeCount equals: 2. + self assert: self t2AB nodeCount equals: 5. "3 direct + 2 in subtree" + self assert: tree nodeCount equals: 4. "2 direct + 2 in subtree" +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testPathOf [ + + | path | + path := tree pathOf: 'One-Two'. + self assert: path equals: #(1 two). + + path := tree pathOf: 'Two'. + self assert: path equals: #(2). + + path := tree pathOf: 'nonexistent'. + self assert: path isNil. ] -{ #category : #'tests - removing' } +{ #category : 'tests' } CTKeyedTreeTest >> testRemovePath [ - self should: [ tree removePath: #(4) ] raise: self defaultTestError. - self should: [ tree removePath: #(1 one) ] raise: self defaultTestError. + + self should: [ tree removePath: #(4) ] raise: KeyNotFound. + self should: [ tree removePath: #(1 one) ] raise: KeyNotFound. + self assert: (tree removePath: #(1 two)) equals: 'One-Two'. self assert: (tree atPath: #(1 two) ifAbsent: [ #missing ]) equals: #missing. self assert: (tree removePath: #(2)) equals: 'Two'. self assert: (tree atPath: #(2) ifAbsent: [ #missing ]) equals: #missing. ] -{ #category : #'tests - removing' } +{ #category : 'tests' } CTKeyedTreeTest >> testRemovePathIfAbsent [ + self assert: (tree removePath: #(4) ifAbsent: [ #none ]) equals: #none. self assert: (tree removePath: #(1 2 3 4) ifAbsent: [ #none ]) equals: #none. self assert: (tree removePath: #(1 two) ifAbsent: [ #none ]) equals: 'One-Two'. @@ -245,9 +395,8 @@ CTKeyedTreeTest >> testRemovePathIfAbsent [ self assert: (tree atPath: #(2) ifAbsent: [ #missing ]) equals: #missing. ] -{ #category : #tests } +{ #category : 'tests' } CTKeyedTreeTest >> testSortBlock [ - "Test the sort block for keys." | treeWithMixedKeys sortedKeys | treeWithMixedKeys := CTKeyedTree new @@ -259,23 +408,51 @@ CTKeyedTreeTest >> testSortBlock [ self assert: sortedKeys asArray equals: #(#a 1 2) ] -{ #category : #'tests - operation' } +{ #category : 'tests' } CTKeyedTreeTest >> testSubtrees [ - | t1 t2 t3 t4 | - t2 := self t2. - t3 := self t13. - t1 := CTKeyedTree new - at: 1 put: t2; - at: 2 put: '2'; - at: 3 put: (t4 := self t13); - yourself. - self assert: t1 subtrees equals: {t2. t4}. - self assert: (t1 at: 1) subtrees equals: {t3}. + + | subtreeList | + subtreeList := tree subtrees. + self assert: subtreeList size equals: 1. + self assert: (subtreeList includes: firstLevelOneSubTree). + + self assert: self t13 subtrees isEmpty. + self assert: self t2AB subtrees size equals: 1. ] -{ #category : #'tests - operation' } +{ #category : 'tests' } CTKeyedTreeTest >> testSubtreesEmpty [ | emptyTree | emptyTree := CTKeyedTree new. self assert: emptyTree subtrees isEmpty. -] \ No newline at end of file +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testTreeProperties [ + + self assert: CTKeyedTree new treeDepth equals: 0. + self assert: self t13 treeDepth equals: 1. + self assert: self t2AB treeDepth equals: 2. + self assert: tree treeDepth equals: 2. + + self assert: CTKeyedTree new treeSize equals: 0. + self assert: self t13 treeSize equals: 2. + self assert: tree treeSize equals: 3. +] + +{ #category : 'tests' } +CTKeyedTreeTest >> testTypeConsistency [ + + | mixedTree | + mixedTree := CTKeyedTree new + at: 'string' put: 'value'; + at: 42 put: 'number'; + at: #symbol put: 'symbol'; + at: $a put: 'character'; + yourself. + + self assert: (mixedTree at: 'string') equals: 'value'. + self assert: (mixedTree at: 42) equals: 'number'. + self assert: (mixedTree at: #symbol) equals: 'symbol'. + self assert: (mixedTree at: $a) equals: 'character'. +] diff --git a/src/Containers-KeyedTree-Tests/package.st b/src/Containers-KeyedTree-Tests/package.st index 56f63a4..b483ac0 100644 --- a/src/Containers-KeyedTree-Tests/package.st +++ b/src/Containers-KeyedTree-Tests/package.st @@ -1 +1 @@ -Package { #name : #'Containers-KeyedTree-Tests' } +Package { #name : 'Containers-KeyedTree-Tests' } diff --git a/src/Containers-KeyedTree/CTKeyedTree.class.st b/src/Containers-KeyedTree/CTKeyedTree.class.st index 870fcde..38cb423 100644 --- a/src/Containers-KeyedTree/CTKeyedTree.class.st +++ b/src/Containers-KeyedTree/CTKeyedTree.class.st @@ -1,165 +1,616 @@ " -I'm a special kind of dictionary. I provide path-based access to elements contained in the receiver and any subtrees. +I represent a hierarchical data structure that provides path-based access to nested elements with dictionary-like functionality. -Example: +I extend Dictionary behavior to support tree-like structures where values can be accessed through paths represented as arrays of keys. Each node can contain both direct values and subtrees, enabling hierarchical data organization similar to file systems or nested configurations. -[[[ -(CTKeyedTree new - at: 1 put: 'One'; - at: 2 put: 'Two'; - at: 'Tree' put: (CTKeyedTree new - at: $a put: 'Tree-A'; - at: $b put: 'Tree-B'; - yourself); - yourself) atPath: #('Tree' $b) ->>> 'Tree-B' -]]] +I am ideal for configuration management, file system representations, menu systems, and any scenario requiring structured hierarchical data with efficient path-based operations. + +Key features: +- Path-based access using arrays of keys: atPath: #(level1 level2 key) +- Automatic subtree creation when needed +- Intelligent merging of tree structures +- Safe access with flexible conditional blocks +- All standard Dictionary operations plus tree-specific methods +- Full Collection protocol implementation + +Example: + tree := CTKeyedTree new + at: #config put: (CTKeyedTree new + at: #database put: (CTKeyedTree new + at: #host put: 'localhost'; + at: #port put: 5432; + yourself); + yourself); + at: #appName put: 'MyApp'; + yourself. + tree atPath: #(config database host). => 'localhost' + tree atPath: #(config database port). => 5432 " Class { - #name : #CTKeyedTree, - #superclass : #Dictionary, - #category : 'Containers-KeyedTree' + #name : 'CTKeyedTree', + #superclass : 'Dictionary', + #category : 'Containers-KeyedTree', + #package : 'Containers-KeyedTree' } -{ #category : #samples } -CTKeyedTree class >> exampleKeyedTree1 [ +{ #category : 'examples' } +CTKeyedTree class >> exampleConfiguration [ + + + ^ self class new + at: #database put: (self class new + at: #host put: 'localhost'; + at: #port put: 5432; + at: #ssl put: true; + yourself); + at: #cache put: (self class new + at: #type put: 'redis'; + at: #host put: 'cache.local'; + at: #timeout put: 5000; + yourself); + at: #appName put: 'SampleApp'; + at: #version put: '1.2.0'; + yourself +] + +{ #category : 'examples' } +CTKeyedTree class >> exampleFileSystemTree [ + + + ^ self class new + at: #home put: (self class new + at: #user put: (self class new + at: #documents put: (self class new + at: 'report.pdf' put: 'PDF Document'; + at: 'notes.txt' put: 'Text File'; + yourself); + at: #downloads put: (self class new + at: 'installer.dmg' put: 'Disk Image'; + yourself); + yourself); + yourself); + at: #etc put: (self class new + at: 'config.json' put: 'Configuration File'; + yourself); + yourself +] + +{ #category : 'examples' } +CTKeyedTree class >> exampleMenuSystem [ + + "Example of using KeyedTree for hierarchical menu structures" - ^ CTKeyedTree new - at: 1 put: 'One'; - at: 2 put: 'Two'; - at: 'Tree' - put: - (CTKeyedTree new - at: $a put: 'Tree-A'; - at: $b put: 'Tree-B'; + ^ self class new + at: #file put: (self class new + at: #new put: 'Create New File'; + at: #open put: 'Open File'; + at: #recent put: (self class new + at: #file1 put: 'recent1.txt'; + at: #file2 put: 'recent2.txt'; yourself); + yourself); + at: #edit put: (self class new + at: #copy put: 'Copy'; + at: #paste put: 'Paste'; + yourself); yourself ] -{ #category : #accessing } +{ #category : 'accessing' } CTKeyedTree >> allKeys [ - "Answer an ordered collection of the keys of the receiver and any subtrees. Please no circular references!" - | answer | - answer := OrderedCollection new. - answer addAll: self keys. - self subtrees do: [ :t | answer addAll: t allKeys ]. - ^ answer + + "Answer an ordered collection containing all keys from this tree and its subtrees." + + | result | + result := OrderedCollection new. + result addAll: self keys. + self subtrees do: [ :subtree | + result addAll: subtree allKeys ]. + ^ result ] -{ #category : #accessing } -CTKeyedTree >> atPath: anArray [ - "Answer the element referenced by the given key path. Signal an error if not found." - ^ self atPath: anArray ifAbsent: [ self errorKeyNotFound: anArray ] +{ #category : 'accessing' } +CTKeyedTree >> allPaths [ + + "Answer all possible paths in this tree as an array of path arrays. + Each path leads to a leaf value (non-tree value)." + + | paths | + paths := OrderedCollection new. + self allPathsStartingWith: #() into: paths. + ^ paths asArray ] -{ #category : #accessing } -CTKeyedTree >> atPath: anArray ifAbsent: aBlock [ - | element | - element := self. - anArray do: [ :key | - (element isKindOf: self class) - ifTrue: [ element := element at: key ifAbsent: [ ^aBlock value ] ] - ifFalse: [ ^aBlock value ] ]. - ^ element +{ #category : 'private' } +CTKeyedTree >> allPathsStartingWith: pathPrefix into: aCollection [ + + "Private method to recursively collect all paths starting with the given prefix" + + self keysAndValuesDo: [ :key :value | + | currentPath | + currentPath := pathPrefix copyWith: key. + (value isKindOf: self class) + ifTrue: [ value allPathsStartingWith: currentPath into: aCollection ] + ifFalse: [ aCollection add: currentPath ] ] ] -{ #category : #accessing } -CTKeyedTree >> atPath: anArray ifAbsentPut: aBlock [ - "Answer the element referenced by the given key path. Answer the value of aBlock if not found after creating its path." - | element | - anArray isEmpty ifTrue: [ ^self ]. - element := self. - anArray allButLastDo: [ :key | element := element at: key ifAbsentPut: [ self species new ] ]. - ^ element at: anArray last ifAbsentPut: aBlock +{ #category : 'enumerating' } +CTKeyedTree >> anySatisfy: aBlock [ + + self valuesDo: [ :value | + (aBlock value: value) ifTrue: [ ^ true ]. + (value isKindOf: self class) ifTrue: [ + (value anySatisfy: aBlock) ifTrue: [ ^ true ] ] ]. + ^ false +] + +{ #category : 'converting' } +CTKeyedTree >> asArray [ + + | result | + result := OrderedCollection new. + self valuesDo: [ :value | + (value isKindOf: self class) + ifTrue: [ result addAll: value ] + ifFalse: [ result add: value ] ]. + ^ result asArray +] + +{ #category : 'converting' } +CTKeyedTree >> asDictionary [ + + | dict | + dict := Dictionary new. + self keysAndValuesDo: [ :key :value | + dict at: key put: ( + (value isKindOf: self class) + ifTrue: [ value asDictionary ] + ifFalse: [ value ]) ]. + ^ dict +] + +{ #category : 'accessing' } +CTKeyedTree >> atPath: pathArray [ + + "Answer the element at the given path. Signal KeyNotFound if not found." + + ^ self atPath: pathArray ifAbsent: [ + KeyNotFound signalFor: pathArray in: self ] +] + +{ #category : 'accessing' } +CTKeyedTree >> atPath: pathArray ifAbsent: absentBlock [ + + "Answer the element at the given path, or the result of absentBlock if not found." + + | currentElement | + currentElement := self. + pathArray do: [ :key | + (currentElement isKindOf: self class) + ifTrue: [ + currentElement := currentElement + at: key + ifAbsent: [ ^ absentBlock value ] ] + ifFalse: [ ^ absentBlock value ] ]. + ^ currentElement ] -{ #category : #accessing } -CTKeyedTree >> atPath: anArray put: aBlock [ - "Answer the value of aBlock after creating its path." +{ #category : 'accessing' } +CTKeyedTree >> atPath: pathArray ifAbsent: absentBlock ifPresent: presentBlock [ + + "Two-way conditional access to path elements" + | element | - anArray isEmpty ifTrue: [ ^self ]. - element := self. - anArray allButLastDo: [ :key | element := element at: key ifAbsentPut: [ self species new ] ]. - ^ element at: anArray last put: aBlock + element := self atPath: pathArray ifAbsent: [ ^ absentBlock value ]. + ^ presentBlock cull: element +] + +{ #category : 'accessing' } +CTKeyedTree >> atPath: pathArray ifAbsentPut: absentBlock [ + + "Answer the element at the given path. If not found, create the path and set the value from absentBlock." + + | currentElement | + pathArray isEmpty ifTrue: [ ^ self ]. + + currentElement := self. + pathArray allButLastDo: [ :key | + currentElement := currentElement + at: key + ifAbsentPut: [ self species new ] ]. + + ^ currentElement at: pathArray last ifAbsentPut: absentBlock +] + +{ #category : 'accessing' } +CTKeyedTree >> atPath: pathArray ifPresent: presentBlock [ + + "Evaluate presentBlock with the element at pathArray if it exists. Otherwise answer nil." + + ^ self + atPath: pathArray + ifAbsent: [ nil ] + ifPresent: presentBlock +] + +{ #category : 'accessing' } +CTKeyedTree >> atPath: pathArray put: value [ + "Set the element at the given path to value. Create intermediate paths as needed." + + | currentElement | + pathArray isEmpty ifTrue: [ ^ value ]. + + currentElement := self. + pathArray allButLastDo: [ :key | + currentElement := currentElement + at: key + ifAbsentPut: [ self species new ]. + + "Add this check to provide a better error message" + (currentElement isKindOf: self class) ifFalse: [ + ^ KeyNotFound signalFor: key in: self ] ]. + + ^ currentElement at: pathArray last put: value ] -{ #category : #printing } +{ #category : 'enumerating' } +CTKeyedTree >> collect: aBlock [ + + "Answer a new collection with transformed values. Maintains tree structure." + + | result | + result := self species new. + self keysAndValuesDo: [ :key :value | + result at: key put: ( + (value isKindOf: self class) + ifTrue: [ value collect: aBlock ] + ifFalse: [ aBlock value: value ] ) ]. + ^ result +] + +{ #category : 'copying' } +CTKeyedTree >> copy [ + + "Answer a deep copy of the receiver including all subtrees." + + | result | + result := self species new. + self keysAndValuesDo: [ :key :value | + result at: key put: ( + (value isKindOf: self class) + ifTrue: [ value copy ] + ifFalse: [ value ] ) ]. + ^ result +] + +{ #category : 'accessing' } +CTKeyedTree >> depth [ + + "Answer the maximum depth of this tree (number of levels)" + + | maxSubtreeDepth | + self isEmpty ifTrue: [ ^ 0 ]. + + maxSubtreeDepth := self subtrees + inject: 0 + into: [ :max :subtree | max max: subtree depth ]. + + ^ 1 + maxSubtreeDepth +] + +{ #category : 'enumerating' } +CTKeyedTree >> detect: aBlock ifNone: noneBlock [ + + "Answer the first element that satisfies the condition, including in subtrees." + + self valuesDo: [ :value | + (value isKindOf: self class) + ifTrue: [ + | found | + found := value detect: aBlock ifNone: [ nil ]. + found ifNotNil: [ ^ found ] ] + ifFalse: [ + (aBlock value: value) ifTrue: [ ^ value ] ] ]. + ^ noneBlock value +] + +{ #category : 'enumerating' } +CTKeyedTree >> do: aBlock [ + + self valuesDo: [ :value | + (value isKindOf: self class) + ifTrue: [ value do: aBlock ] + ifFalse: [ aBlock value: value ] ] +] + +{ #category : 'accessing' } +CTKeyedTree >> existsPath: pathArray [ + + "Answer true if a path exists in the tree." + + ^ (self atPath: pathArray ifAbsent: [ nil ]) notNil +] + +{ #category : 'printing' } CTKeyedTree >> formattedText [ - "Answer a string or text representing the receiver with indentation and, possibly, markup." - ^ String new writeStreamDo: [ :str | - self putFormattedTextOn: str level: 0 indentString: ' '. - str contents ] + + "Answer a formatted string representation with proper indentation." + + ^ String streamContents: [ :stream | + self putFormattedTextOn: stream level: 0 indentString: ' ' ] ] -{ #category : #adding } +{ #category : 'testing' } +CTKeyedTree >> hasPath: pathArray [ + + "Answer true if the given path exists in this tree." + + ^ self existsPath: pathArray +] + +{ #category : 'testing' } +CTKeyedTree >> hasSubtrees [ + + "Answer true if the receiver contains any subtrees." + + ^ self anySatisfy: [ :value | value isKindOf: self class ] +] + +{ #category : 'testing' } +CTKeyedTree >> includesPath: pathArray [ + + "Answer true if the path exists in the tree." + + ^ self hasPath: pathArray +] + +{ #category : 'testing' } +CTKeyedTree >> isDeep [ + + "Answer true if this tree has subtrees (depth > 1)." + + ^ self hasSubtrees +] + +{ #category : 'testing' } +CTKeyedTree >> isFlat [ + + "Answer true if this tree contains no subtrees (depth = 1)." + + ^ self hasSubtrees not +] + +{ #category : 'testing' } +CTKeyedTree >> isLeaf [ + + "Answer true if this tree contains no subtrees (only direct values)." + + ^ self subtrees isEmpty +] + +{ #category : 'enumerating' } +CTKeyedTree >> keysAndPathsDo: aBlock [ + + "Evaluate aBlock with each key and its full path from root" + + self keysAndPathsStartingWith: #() do: aBlock +] + +{ #category : 'private' } +CTKeyedTree >> keysAndPathsStartingWith: pathPrefix do: aBlock [ + + "Private method for recursive path enumeration" + + self keysAndValuesDo: [ :key :value | + | fullPath | + fullPath := pathPrefix copyWith: key. + aBlock value: key value: fullPath. + (value isKindOf: self class) + ifTrue: [ value keysAndPathsStartingWith: fullPath do: aBlock ] ] +] + +{ #category : 'accessing' } +CTKeyedTree >> leafValues [ + + "Answer a collection of all non-tree values in this tree" + + | leaves | + leaves := OrderedCollection new. + self keysAndValuesDo: [ :key :value | + (value isKindOf: self class) + ifTrue: [ leaves addAll: value leafValues ] + ifFalse: [ leaves add: value ] ]. + ^ leaves +] + +{ #category : 'actions' } CTKeyedTree >> merge: aKeyedTree [ - "Merge the given tree into the receiver, overwriting or extending elements as needed." - aKeyedTree keysAndValuesDo: [ :k :v | - | subtree | - (v isKindOf: CTKeyedTree) + + "Merge the given tree into the receiver. Subtrees are merged recursively, other values are overwritten." + + aKeyedTree keysAndValuesDo: [ :key :value | + | existingValue | + existingValue := self at: key ifAbsent: [ nil ]. + + (value isKindOf: self class) + ifTrue: [ + (existingValue isKindOf: self class) + ifTrue: [ existingValue merge: value ] + ifFalse: [ self at: key put: value copy ] ] + ifFalse: [ self at: key put: value ] ]. + ^ self +] + +{ #category : 'accessing' } +CTKeyedTree >> nodeCount [ + + "Answer the total number of key-value pairs in this tree and all its subtrees." + + ^ self size + (self subtrees + inject: 0 + into: [ :sum :subtree | sum + subtree nodeCount ]) +] + +{ #category : 'selecting' } +CTKeyedTree >> pathOf: anObject [ + + "Answer the path to the first occurrence of anObject in this tree, or nil if not found" + + ^ self pathOf: anObject startingWith: #() +] + +{ #category : 'private' } +CTKeyedTree >> pathOf: anObject startingWith: pathPrefix [ + + self keysAndValuesDo: [ :key :value | + | currentPath | + currentPath := pathPrefix copyWith: key. + value = anObject ifTrue: [ ^ currentPath ]. + (value isKindOf: self class) ifTrue: [ + | foundPath | + foundPath := value pathOf: anObject startingWith: currentPath. + foundPath ifNotNil: [ ^ foundPath ] ] ]. + ^ nil +] + +{ #category : 'enumerating' } +CTKeyedTree >> pathsAndValuesDo: aBlock [ + + "Execute aBlock with each path-value pair in the tree." + + self pathsAndValuesDo: aBlock currentPath: #() +] + +{ #category : 'enumerating' } +CTKeyedTree >> pathsAndValuesDo: aBlock currentPath: pathArray [ + + self keysAndValuesDo: [ :key :value | + | newPath | + newPath := pathArray copyWith: key. + (value isKindOf: self class) ifTrue: [ - subtree := self at: k ifAbsentPut: [ v species new ]. - (subtree isKindOf: CTKeyedTree) - ifFalse: [ subtree := self at: k put: v species new ]. - subtree merge: v ] - ifFalse: [ self at: k put: v ] ] + aBlock value: newPath value: value. + value pathsAndValuesDo: aBlock currentPath: newPath ] + ifFalse: [ aBlock value: newPath value: value ] ] ] -{ #category : #copying } +{ #category : 'copying' } CTKeyedTree >> postCopy [ - "Must copy the associations, or later store will affect both the original and the copy. Copy any subtrees too!" + + "Ensure proper deep copying of associations and subtrees." + array := array collect: [ :assoc | - assoc ifNil: [ nil ] - ifNotNil: [ Association + assoc ifNotNil: [ + Association key: assoc key - value: ((assoc value isKindOf: CTKeyedTree) + value: ((assoc value isKindOf: self class) ifTrue: [ assoc value copy ] ifFalse: [ assoc value ]) ] ] ] -{ #category : #printing } -CTKeyedTree >> putFormattedTextOn: aStream level: indentLevel indentString: aString [ - "Write a textual representation of the receiver to aStream, indenting to indentLevel using aString as the indent string." - - (self keys asSortedCollection: self sortBlock) - do: [ :k | - | v | - indentLevel = 0 - ifFalse: [ - indentLevel = 1 - ifTrue: [ aStream nextPutAll: aString ] - ifFalse: [ indentLevel - 1 timesRepeat: [ aStream nextPutAll: aString ]. aStream nextPutAll: ' ' ] ]. - aStream nextPutAll: k printString. - v := self at: k. - (v isKindOf: self class) - ifTrue: [ aStream cr. - v putFormattedTextOn: aStream level: indentLevel + 1 indentString: aString ] - ifFalse: [ aStream - nextPutAll: ' : '; - nextPutAll: v printString. - aStream cr ] ] -] - -{ #category : #removing } -CTKeyedTree >> removePath: anArray [ - "Remove and answer the element referenced by the given path. Signal an error if not found." - ^ self removePath: anArray ifAbsent: [ self errorKeyNotFound: anArray ] -] - -{ #category : #removing } -CTKeyedTree >> removePath: anArray ifAbsent: aBlock [ - "Remove and answer the element referenced by the given path. Answer the value of aBlock if not found." - | element | - anArray isEmpty ifTrue: [ ^self ]. - element := self. - anArray allButLastDo: [ :key | element := element at: key ifAbsent: [ ^aBlock value ] ]. - ^ element removeKey: anArray last ifAbsent: aBlock +{ #category : 'printing' } +CTKeyedTree >> printOn: aStream [ + + "Print a concise representation showing the tree structure." + + aStream nextPutAll: self class name. + aStream nextPut: $(. + self isEmpty + ifTrue: [ aStream nextPutAll: 'empty' ] + ifFalse: [ + aStream print: self size. + aStream nextPutAll: ' keys'. + self hasSubtrees ifTrue: [ + aStream nextPutAll: ', '. + aStream print: self subtrees size. + aStream nextPutAll: ' subtrees' ] ]. + aStream nextPut: $) +] + +{ #category : 'printing' } +CTKeyedTree >> putFormattedTextOn: aStream level: indentLevel indentString: indentString [ + + "Write formatted representation to stream with proper indentation." + + | sortedKeys | + sortedKeys := self keys asSortedCollection: self sortBlock. + + sortedKeys do: [ :key | + | value | + value := self at: key. + + "Add indentation" + indentLevel > 0 ifTrue: [ + indentLevel - 1 timesRepeat: [ aStream nextPutAll: indentString ]. + aStream nextPutAll: ' ' ]. + + "Add key" + aStream nextPutAll: key printString. + + "Add value or recurse into subtree" + (value isKindOf: self class) + ifTrue: [ + aStream cr. + value putFormattedTextOn: aStream + level: indentLevel + 1 + indentString: indentString ] + ifFalse: [ + aStream nextPutAll: ' : '. + aStream nextPutAll: value printString. + aStream cr ] ] ] -{ #category : #accessing } +{ #category : 'removing' } +CTKeyedTree >> removePath: pathArray [ + + "Remove and answer the element at the given path. Signal error if not found." + + ^ self removePath: pathArray ifAbsent: [ + KeyNotFound signalFor: pathArray in: self ] +] + +{ #category : 'removing' } +CTKeyedTree >> removePath: pathArray ifAbsent: absentBlock [ + + "Remove and answer the element at the given path, or execute absentBlock if not found." + + | currentElement | + pathArray isEmpty ifTrue: [ ^ absentBlock value ]. + + currentElement := self. + pathArray allButLastDo: [ :key | + currentElement := currentElement + at: key + ifAbsent: [ ^ absentBlock value ] ]. + + ^ currentElement removeKey: pathArray last ifAbsent: absentBlock +] + +{ #category : 'enumerating' } +CTKeyedTree >> select: aBlock [ + + "Answer a new tree containing only elements that satisfy the condition." + + | result | + result := self species new. + self keysAndValuesDo: [ :key :value | + (value isKindOf: self class) + ifTrue: [ + | selectedSubtree | + selectedSubtree := value select: aBlock. + selectedSubtree isEmpty ifFalse: [ + result at: key put: selectedSubtree ] ] + ifFalse: [ + (aBlock value: value) ifTrue: [ + result at: key put: value ] ] ]. + ^ result +] + +{ #category : 'sorting' } CTKeyedTree >> sortBlock [ - "Answer a sort block that can be used to sort the keys of the receiver." + "Answer a sort block for ordering keys. Symbols come before numbers, then by class name." + ^ [ :a :b | a class = b class ifTrue: [ a <= b ] @@ -172,18 +623,47 @@ CTKeyedTree >> sortBlock [ ifFalse: [ a class name <= b class name ] ] ] ] ] -{ #category : #accessing } +{ #category : 'accessing' } CTKeyedTree >> subtrees [ - "Answer the subtrees of the receiver." - ^ (self select: [ :v | v isKindOf: CTKeyedTree ]) values + "Answer a collection of all immediate subtrees." + + ^ self values select: [ :each | each isKindOf: self class ] ] -{ #category : #tests } -CTKeyedTreeTest >> testFormattedText [ - "Test the formatted text representation of the tree." +{ #category : 'accessing' } +CTKeyedTree >> treeDepth [ + + ^ self depth +] - self assert: self t13 formattedText equals: - '1 : ''1-3-1'' -2 : ''1-3-2'' -' -] \ No newline at end of file +{ #category : 'accessing' } +CTKeyedTree >> treeSize [ + "Answer the total number of leaf elements in the tree including all subtrees." + + | count | + count := 0. + self valuesDo: [ :value | + count := (value isKindOf: self class) + ifTrue: [ count + value treeSize ] + ifFalse: [ count + 1 ] ]. + ^ count +] + +{ #category : 'enumerating' } +CTKeyedTree >> valuesAndPathsDo: aBlock [ + +"Evaluate aBlock with each leaf value and its full path from root" + + self valuesAndPathsStartingWith: #() do: aBlock +] + +{ #category : 'private' } +CTKeyedTree >> valuesAndPathsStartingWith: pathPrefix do: aBlock [ + + self keysAndValuesDo: [ :key :value | + | fullPath | + fullPath := pathPrefix copyWith: key. + (value isKindOf: self class) + ifTrue: [ value valuesAndPathsStartingWith: fullPath do: aBlock ] + ifFalse: [ aBlock value: value value: fullPath ] ] +] diff --git a/src/Containers-KeyedTree/package.st b/src/Containers-KeyedTree/package.st index cd66dcf..07df04c 100644 --- a/src/Containers-KeyedTree/package.st +++ b/src/Containers-KeyedTree/package.st @@ -1 +1 @@ -Package { #name : #'Containers-KeyedTree' } +Package { #name : 'Containers-KeyedTree' }