在人格分析领域,荣格八维理论通过八个认知功能维度解析人格结构,而多智能体系统则能模拟不同维度的分析逻辑。本文以程序员视角,详解使用 VB 开发多智能体协作的荣格八维分析器的实现方案,通过代码示例展示智能体架构设计、八维算法实现与协作机制开发,为心理分析工具开发提供技术参考。

架构设计:多智能体协作系统的框架搭建

多智能体系统的核心在于通过多个专项智能体的协同工作实现复杂分析任务。荣格八维分析器需要构建不同功能的智能体处理感知、判断、情感等维度的分析,并设计协调机制实现结果融合。

多智能体架构核心代码


' 智能体基类定义

Public MustInherit Class AgentBase

Protected m_agentID As String

Protected m_agentName As String

Protected m_priority As Integer ' 智能体优先级

Protected m_isActive As Boolean ' 智能体激活状态

Public Event AnalysisCompleted(sender As Object, result As AnalysisResult)

Public Event AgentError(sender As Object, errorMsg As String)

Public Sub New(agentID As String, agentName As String, priority As Integer)

m_agentID = agentID

m_agentName = agentName

m_priority = priority

m_isActive = True

End Sub

Public ReadOnly Property AgentID As String

Get

Return m_agentID

End Get

End Property

Public ReadOnly Property AgentName As String

Get

Return m_agentName

End Get

End Property

Public Property IsActive As Boolean

Get

Return m_isActive

End Get

Set(value As Boolean)

m_isActive = value

End Set

End Property

' 抽象方法:执行分析

Public MustOverride Sub PerformAnalysis(inputData As AnalysisInput)

' 抽象方法:重置智能体状态

Public MustOverride Sub ResetAgent()

End Class

' 协调器类:管理智能体协作

Public Class AgentCoordinator

Private m_agents As Dictionary(Of String, AgentBase)

Private m_analysisResults As Dictionary(Of String, AnalysisResult)

Private m_lockObj As New Object()

Public Sub New()

m_agents = New Dictionary(Of String, AgentBase)

m_analysisResults = New Dictionary(Of String, AnalysisResult)

End Sub

' 注册智能体

Public Sub RegisterAgent(agent As AgentBase)

If Not m_agents.ContainsKey(agent.AgentID) Then

m_agents.Add(agent.AgentID, agent)

' 订阅智能体事件

AddHandler agent.AnalysisCompleted, AddressOf Agent_AnalysisCompleted

AddHandler agent.AgentError, AddressOf Agent_AgentError

End If

End Sub

' 移除智能体

Public Sub RemoveAgent(agentID As String)

If m_agents.ContainsKey(agentID) Then

Dim agent = m_agents(agentID)

RemoveHandler agent.AnalysisCompleted, AddressOf Agent_AnalysisCompleted

RemoveHandler agent.AgentError, AddressOf Agent_AgentError

m_agents.Remove(agentID)

End If

End Sub

' 启动所有智能体分析

Public Sub StartAnalysis(inputData As AnalysisInput)

SyncLock m_lockObj

m_analysisResults.Clear()

End SyncLock

' 按优先级启动智能体

For Each agent In m_agents.Values.OrderBy(Function(a) a.Priority)

If agent.IsActive Then

agent.PerformAnalysis(inputData)

End If

Next

End Sub

' 智能体分析完成事件处理

Private Sub Agent_AnalysisCompleted(sender As Object, result As AnalysisResult)

Dim agent = DirectCast(sender, AgentBase)

SyncLock m_lockObj

If Not m_analysisResults.ContainsKey(agent.AgentID) Then

m_analysisResults.Add(agent.AgentID, result)

Else

m_analysisResults(agent.AgentID) = result

End If

End SyncLock

' 检查是否所有智能体都已完成

If m_analysisResults.Count = m_agents.Count Then

RaiseEvent AllAnalysesCompleted(Me, MergeResults())

End If

End Sub

' 合并分析结果

Private Function MergeResults() As CompositeResult

Dim composite As New CompositeResult()

composite.AnalysisTime = DateTime.Now

composite.Results = New List(Of AnalysisResult)(m_analysisResults.Values)

' 计算综合得分

For Each result In composite.Results

For Each score In result.DimensionScores

If Not composite.FinalScores.ContainsKey(score.DimensionName) Then

composite.FinalScores.Add(score.DimensionName, 0)

End If

' 按智能体优先级加权计算

composite.FinalScores(score.DimensionName) +=

score.Score * (result.SourceAgentPriority / 10)

Next

Next

Return composite

End Function

Public Event AllAnalysesCompleted(sender As Object, finalResult As CompositeResult)

Public Event AnalysisError(sender As Object, errorMsg As String)

Private Sub Agent_AgentError(sender As Object, errorMsg As String)

RaiseEvent AnalysisError(sender, errorMsg)

End Sub

End Class

' 数据模型类

Public Class AnalysisInput

Public Property UserResponses As Dictionary(Of String, Integer) ' 问题ID与回答

Public Property UserContext As String ' 用户上下文信息

Public Property AnalysisMode As String ' 分析模式

End Class

Public Class AnalysisResult

Public Property SourceAgentID As String

Public Property SourceAgentName As String

Public Property SourceAgentPriority As Integer

Public Property DimensionScores As List(Of DimensionScore)

Public Property AnalysisNotes As String

Public Property AnalysisTime As DateTime

End Class

Public Class DimensionScore

Public Property DimensionName As String

Public Property Score As Double ' 0-100分

PublicProperty Confidence As Double ' 可信度0-1

Public Property Interpretation As String ' 维度解释

End Class

该架构采用分层设计思想:AgentBase 作为抽象基类定义智能体核心接口,所有专项智能体都继承自此基类;AgentCoordinator 作为协调器负责智能体注册、任务分发与结果融合;数据模型类标准化输入输出格式。这种设计的优势在于:通过事件驱动机制实现智能体间的松耦合通信;采用优先级加权算法融合多源结果;支持动态添加或移除智能体实现功能扩展。协调器中的合并算法考虑了不同智能体的专业权重,使综合结果更具参考价值。

核心算法:荣格八维分析的实现逻辑

荣格八维分析的核心是对八个认知功能维度(外倾感觉、内倾感觉、外倾直觉、内倾直觉、外倾思考、内倾思考、外倾情感、内倾情感)的量化评估。每个维度需要专用智能体实现独特的分析逻辑,并基于用户输入计算维度得分。

八维分析算法代码实现


' 外倾思考(Te)智能体

Public Class TeAgent

Inherits AgentBase

Public Sub New()

MyBase.New("TE_AGENT", "外倾思考分析智能体", 8)

End Sub

Public Overrides Sub PerformAnalysis(inputData As AnalysisInput)

Try

Dim result As New AnalysisResult()

result.SourceAgentID = m_agentID

result.SourceAgentName = m_agentName

result.SourceAgentPriority = m_priority

result.DimensionScores = New List(Of DimensionScore)

result.AnalysisTime = DateTime.Now

' 计算外倾思考维度得分

Dim teScore As New DimensionScore()

teScore.DimensionName = "外倾思考(Te)"

teScore.Score = CalculateTeScore(inputData.UserResponses)

teScore.Confidence = CalculateConfidence(inputData.UserResponses)

teScore.Interpretation = GetInterpretation(teScore.Score)

result.DimensionScores.Add(teScore)

result.AnalysisNotes = "基于逻辑推理与客观判断的评估"

RaiseEvent AnalysisCompleted(Me, result)

Catch ex As Exception

RaiseEvent AgentError(Me, $"Te分析失败: {ex.Message}")

End Try

End Sub

' 计算外倾思考得分

Private Function CalculateTeScore(responses As Dictionary(Of String, Integer)) As Double

' 相关问题权重配置

Dim questionWeights As New Dictionary(Of String, Double) From {

{"Q1", 0.15}, {"Q5", 0.12}, {"Q12", 0.18},

{"Q18", 0.20}, {"Q23", 0.15}, {"Q30", 0.20}

}

Dim totalScore As Double = 0

Dim weightSum As Double = 0

' 计算加权得分

For Each q In questionWeights

If responses.ContainsKey(q.Key) Then

' 回答值1-5转换为0-100分

totalScore += (responses(q.Key) - 1) * 25 * q.Value

weightSum += q.Value

End If

Next

' 归一化得分

If weightSum > 0 Then

Return Math.Round(totalScore / weightSum, 1)

End If

Return 0

End Function

' 计算可信度

Private Function CalculateConfidence(responses As Dictionary(Of String, Integer)) As Double

' 基于回答一致性计算可信度

Dim relevantQuestions = {"Q1", "Q5", "Q12", "Q18", "Q23", "Q30"}

Dim validCount = relevantQuestions.Count(Function(q) responses.ContainsKey(q))

' 有效问题越多可信度越高

Return Math.Min(1.0, validCount / 5)

End Function

' 获取维度解释

Private Function GetInterpretation(score As Double) As String

Select Case score

Case Is >= 80

Return "强偏好:擅长逻辑分析、客观决策与系统组织,重视效率与结果"

Case 60 To 79

Return "中强偏好:较善于理性思考与结构化管理,倾向客观判断"

Case 40 To 59

Return "中性:在逻辑分析与其他方式间保持平衡,视情况灵活运用"

Case 20 To 39

Return "较弱偏好:不太依赖逻辑分析,更倾向其他决策方式"

Case Else

Return "弱偏好:较少使用逻辑分析,偏好主观或情感导向的决策"

End Select

End Function

Public Overrides Sub ResetAgent()

' 重置智能体状态

End Sub

End Class

' 内倾情感(Fi)智能体

Public Class FiAgent

Inherits AgentBase

Public Sub New()

MyBase.New("FI_AGENT", "内倾情感分析智能体", 7)

End Sub

Public Overrides Sub PerformAnalysis(inputData As AnalysisInput)

' 内倾情感分析实现逻辑

' 类似TeAgent结构,针对内倾情感维度设计评估算法

' ...

End Sub

Public Overrides Sub ResetAgent()

' 重置逻辑

End Sub

End Class

荣格八维分析算法的核心在于:为每个维度设计针对性的评估模型,通过加权计算将用户回答转换为量化得分;基于得分区间提供解释性文本;通过有效问题数量评估结果可信度。代码中实现的外倾思考 (Te) 智能体采用了以下技术策略:基于专家经验配置问题权重,确保核心问题对结果的影响更大;将原始回答(1-5 分)标准化为 0-100 分的区间,便于跨维度比较;通过分段函数生成符合心理学规范的维度解释。

每个八维智能体都遵循相似的架构但采用不同的评估模型,如内倾情感 (Fi) 智能体更关注价值观与情感一致性相关问题,外倾感觉 (Se) 智能体则侧重现实感知与即时体验类问题的分析。这种专项化设计确保了每个维度评估的专业性与准确性。

系统整合:多智能体协作与结果可视化

完成智能体与算法设计后,需要构建用户交互界面实现数据输入、分析触发与结果展示,并通过协作机制确保多智能体高效协同工作,最终以直观方式呈现荣格八维分析结果。

系统整合与可视化代码


' 主分析表单

Public Class MainAnalysisForm

Private agentCoordinator As AgentCoordinator

Private WithEvents backgroundWorker As New BackgroundWorker()

Private Sub MainAnalysisForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load

' 初始化协调器

agentCoordinator = New AgentCoordinator()

AddHandler agentCoordinator.AllAnalysesCompleted, AddressOf Coordinator_AllAnalysesCompleted

AddHandler agentCoordinator.AnalysisError, AddressOf Coordinator_AnalysisError

' 注册所有八维智能体

RegisterAgents()

' 初始化背景工作器

backgroundWorker.WorkerSupportsCancellation = True

End Sub

' 注册智能体

Private Sub RegisterAgents()

agentCoordinator.RegisterAgent(New TeAgent()) ' 外倾思考

agentCoordinator.RegisterAgent(New TiAgent()) ' 内倾思考

agentCoordinator.RegisterAgent(New FeAgent()) ' 外倾情感

agentCoordinator.RegisterAgent(New FiAgent()) ' 内倾情感

agentCoordinator.RegisterAgent(New SeAgent()) ' 外倾感觉

agentCoordinator.RegisterAgent(New SiAgent()) ' 内倾感觉

agentCoordinator.RegisterAgent(New NeAgent()) ' 外倾直觉

agentCoordinator.RegisterAgent(New NiAgent()) ' 内倾直觉

End Sub

' 开始分析按钮

Private Sub btnStartAnalysis_Click(sender As Object, e As EventArgs) Handles btnStartAnalysis.Click

If ValidateInput() Then

' 收集用户输入

Dim inputData As New AnalysisInput()

inputData.UserResponses = CollectResponses()

inputData.UserContext = txtContext.Text

inputData.AnalysisMode = cboAnalysisMode.Text

' 显示加载状态

ShowLoadingState(True)

' 在后台线程启动分析

If Not backgroundWorker.IsBusy Then

backgroundWorker.RunWorkerAsync(inputData)

End If

End If

End Sub

' 后台分析处理

Private Sub backgroundWorker_DoWork(sender As Object, e As DoWorkEventArgs) Handles backgroundWorker.DoWork

Dim inputData = DirectCast(e.Argument, AnalysisInput)

agentCoordinator.StartAnalysis(inputData)

End Sub

' 所有分析完成处理

Private Sub Coordinator_AllAnalysesCompleted(sender As Object, finalResult As CompositeResult)

' 切换到UI线程更新界面

Me.Invoke(Sub()

' 隐藏加载状态

ShowLoadingState(False)

' 展示分析结果

DisplayResults(finalResult)

' 生成人格类型建议

GeneratePersonalitySuggestion(finalResult)

End Sub)

End Sub

' 展示分析结果

Private Sub DisplayResults(result As CompositeResult)

' 清空现有结果

lvScores.Items.Clear()

chartDimensionScores.Series("得分").Points.Clear()

' 显示维度得分列表

For Each score In result.FinalScores.OrderByDescending(Function(kvp) kvp.Value)

Dim item As New ListViewItem(score.Key)

item.SubItems.Add(score.Value.ToString("F1"))

item.SubItems.Add(If(score.Value >= 60, "高", If(score.Value >= 40, "中", "低")))

lvScores.Items.Add(item)

' 添加到图表

chartDimensionScores.Series("得分").Points.AddXY(score.Key, score.Value)

Next

' 显示分析信息

lblAnalysisTime.Text = $"分析时间: {result.AnalysisTime:yyyy-MM-dd HH:mm}"

lblAgentCount.Text = $"参与智能体: {result.Results.Count}个"

End Sub

' 生成人格类型建议

Private Sub GeneratePersonalitySuggestion(result As CompositeResult)

' 获取前四高得分维度

Dim topDimensions = result.FinalScores _

.OrderByDescending(Function(kvp) kvp.Value) _

.Take(4) _

.Select(Function(kvp) kvp.Key) _

.ToList()

' 简单人格类型匹配逻辑

Dim personalityTypes As New Dictionary(Of String, List(Of String)) From {

{"INTP", New List(Of String) From {"内倾思考(Ti)", "外倾直觉(Ne)", "内倾感觉(Si)", "外倾情感(Fe)"}},

{"INTJ", New List(Of String) From {"内倾直觉(Ni)", "外倾思考(Te)", "内倾情感(Fi)", "外倾感觉(Se)"}},

{"ENFP", New List(Of String) From {"外倾情感(Fe)", "内倾直觉(Ni)", "外倾感觉(Se)", "内倾思考(Ti)"</doubaocanvas>

Logo

有“AI”的1024 = 2048,欢迎大家加入2048 AI社区

更多推荐