fNIRS Data Preprocessing使用步骤

本文是近红外数据分析步骤，适用于joint Simon task，使用宏程序fNIRS Data Preprocessing 以及其他宏程序完成，ETG7100型号设备数据格式为编号_HBA_Probe1_Oxy.csv，编号自定义，最好写成sub001_run1这种形式，命名最好采用单数，即第1对被试为sub01，第2对为sub03，方便后续分割两个被试的数据。

fNIRS Data Preprocessing 宏程序介绍

程序界面包括三部分，步骤选择、设置、文件列表查看，如下图。

程序界面

主要使用步骤为首先选择源数据路径，粘贴进对话框后点击File List查看是否正确，然后在 Type of calculation 选择程序，点击Set 设置，设置无误后点击 Start开始。

脑内激活（Intra-brain activation）

前面步骤使用 fNIRS Data Preprocessing程序完成，十三步后可使用自定义宏程序。

Step01. Hitachi

使用 Excel 程序Hitachi更新数据格式

输入目标文件的路径保存 Oxy 数据，按 File List 按钮
从Type of Calculation中选择Hitachi，按Set按钮
按 Start开始程序
结束后程序不会输出新的文件

Step02. Trigger Check

输入目标文件路径，按 File List 按钮
输入结果文件Trigger.xlsx的保存路径
从Type of Calculation中选择Trigger Check，按Set按钮
按 Start开始程序，对话框中输入 1
结束后程序会输出新的文件 Trigger.xlsx

Step03. 格式转换 xlsx to mat

打开 Matlab，路径选择到 Hitachi后的文件路径，左侧出现文件后即成功
输入下列代码转换格式

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
for i = 1:9 # i代表 sub0 后的数量 这里表示 sub01到 sub09
for j = 1:2 # j 代表run数量，有几个修改一下即可
for k = 1:4 # k 代表 Probe数量，即光极片数量
a = ['sub0',num2str(i),'_run', num2str(j),'_HBA_Probe', num2str(k),'_Oxy.csv']
xlsread(a,1)
b = ['sub0',num2str(i),'_run', num2str(j),'_HBA_Probe', num2str(k),'_Oxy.mat']
save(b)
end
end
end

上述代码可以修改 01-09编号的被试数据，如果要修改10以后的数据，可以将第4 、6行代码中 sub0 改为 sub1
回车键执行代码，被试超过10需要多次执行

Step04. 带通滤波(bandpass-filter)

使用 Matlab代码进行带通滤波（通常设置0.01-0.1Hz）（作用是降噪）,将 matlab代码文件和转换格式后的文件放到一个文件夹下

将bandpass-filter设置为当前路径
打开 M 文件data_bpfilt.m，将fs修改为正确采样率（默认设置为fs=10）并保存
打开filt_all.m，设置正确的文件路径，该路径需包含data_bpfilt.m文件,文件路径后记得加“\”
按Run按钮运行filt_all.m代码

Step05. 将 `txt` 格式转为 `xlsx` 文件

将 Eprime数据 txt 格式文件整理到一起
使用 Make xls files程序读取
需要输入源文件路径和保存路径
保存后会输出新的 xlsx 文件

Step06. 提取行为数据

输入源文件路径
选择 BehavData_gather程序
结束后不会生成新的文件，会在原有文件生成新的工作表

Step07. 整合行为数据

输入目标文件 Eprime (.xls)的路径，按 File List按钮
输入行为数据的目标保存路径
输入行为数据的文件名（保留“EprimeData.xlsx”）
输入包含行为数据的表格编号，这里为 2
选择 Gather the files，并开始程序

Step08. 添加 `Mark`

打开第 7 步后生成的文件 EprimeData.xlsx
输入包含带通滤波后的Oxy的目标文件的路径(第4步)
输入“Sheet number of the data”，这里为 1
选择 Mark Add，Set 并 Start
结束后可再执行一次 Trigger Check 程序，步骤与 Step02一致，Step02第4步对话框选择时输入 2

前八步都是进行mark补充的功能，如果Eprime编实验程序时，设置刺激出现前打一个mark，刺激刚出现时打一个mark，刺激出现结束后两秒打一个mark。Mark在设计程序时就已经打好的话，那么前八步就不用操作了。

Step09. 基线校正和Z分数转换

使用添加 mark 后的 oxy文件，如果文件少 mark 会报错
使用程序Baseline correction
结束后不会生成新的文件

Step10. 分离条件

输入基线校正和Z分数转换后的数据路径
选择程序 Data Cut (mode1)
结束后不会生成新的文件

Step11. 计算平均脑激活

输入分离条件后的数据文件夹为源文件夹
选择程序 Average Calculation计算平均脑激活
结束后不会生成新的文件

Step12. 将所有被试数据按条件整合

输入包含平均脑激活的目标文件的路径
输入保存文件的目标路径
输入文件名保存不同实验条件的平均脑激活数据，Condition1/2/3/4，并选择相应的Sheet number，第1个条件在 Sheet1，以此类推
选择程序 Gather the files，按 Set 并 Start

Step13. 将所有被试数据集中到一个 Sheet

输入包含Condition文件目标文件的路径
选择程序 Data Gather(mode1)
按 Set 并 Start

Step14. 整合条件

接下来步骤需要自己新建宏程序
在个人宏工作簿中点击 开发工具-Visual Basic
点击插入-模块
输入下列代码：

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
Option Explicit

Sub 组内整合条件()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim newWb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim i As Long
    Dim col As Long
    Dim lastRow As Long
    Dim header As Range
    Dim filtereRange As Range
    Dim filterValue As String

    Application.ScreenUpdating = False
    
    ' 获取当前文件夹路径'
    myPath = InputBox("请输入文件路径:") & "\"
    myFile = Dir(myPath & "*.xlsx")
    
    ' 新建all_condition工作簿'
    Set newWb = Workbooks.Add
    newWb.SaveAs myPath & "all_condition.xlsx"
    Set ws = newWb.Worksheets(1)
    
    col = 3
    ' 遍历目录下的所有Excel文件'
    Do While myFile <> ""
        If myFile <> "all_condition.xlsx" Then
            ' 打开原始工作簿'
            Set wb = Workbooks.Open(myPath & myFile)
            
            ' 复制第2个工作表的第3到6列到新工作簿'
            With wb.Worksheets("Sheet1DataListSPSS")
                lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
                .Range(.Cells(1, 3), .Cells(lastRow, 6)).Copy ws.Cells(1, col)
            End With
            
            ' 补充表头'
            For i = 1 To 4
                ws.Cells(1, col + i - 1).Value = ws.Cells(1, col + i - 1).Value & "_" & Replace(myFile, ".xlsx", "")
            Next i
            
            col = col + 4
            wb.Close SaveChanges:=False
        End If
        myFile = Dir
    Loop
    
    '复制第一个原始工作簿的前两列'
    Set wb = Workbooks.Open(myPath & Dir(myPath & "Condition1.xlsx"))
    With wb.Worksheets("Sheet1DataListSPSS")
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(lastRow, 2)).Copy ws.Cells(1, 1)
    End With
    wb.Close SaveChanges:=False
    
    ' 保存新工作簿修改'
    newWb.Save
    
    ' 复制第一个工作表'
    ws.Copy After:=ws
    Set ws = newWb.Worksheets(2)
    
    ' 添加subject列'
    ws.Columns(2).Insert
    ws.Cells(1, 1).Value = "subject_pair"
    ws.Cells(1, 2).Value = "subject"
    
    ' 修改subject列内容'
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        Dim parts() As String
        parts = Split(ws.Cells(i, 1).Value, "_")
        If InStr(parts(2), "Probe1") > 0 Or InStr(parts(2), "Probe2") > 0 Then
            ws.Cells(i, 2).Value = parts(0) & "_" & parts(1)
        Else
            ws.Cells(i, 2).Value = "sub" & Format(CInt(Mid(parts(0), 4)) + 1, "000") & "_" & parts(1)
            ' 交换第3到6列和第7到10列'
            Dim temp As Variant
            Dim j As Long
            Dim k As Long
            For j = 4 To 7
                temp = ws.Cells(i, j).Value
                ws.Cells(i, j).Value = ws.Cells(i, j + 4).Value
                ws.Cells(i, j + 4).Value = temp
            Next j
            
            ' 交换第11到14列和第15到18列'
            For k = 12 To 15
                temp = ws.Cells(i, k).Value
                ws.Cells(i, k).Value = ws.Cells(i, k + 4).Value
                ws.Cells(i, k + 4).Value = temp
            Next k
        End If
    Next i
    
    ' 删除第1列并排序'
    ws.Columns(1).Delete
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add Key:=ws.Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' Turn on screen updating'
    Application.ScreenUpdating = True
    newWb.Save
End Sub

保存后运行，输入 Step13 后的文件路径后点击确定开始

**注意：**这里程序会将 Probe1 & 2的数据和Probe3 & 4的数据分开，将 Probe3 & 4的数据编号加1，如果被试编号不是单数命名则不能使用此程序

同时程序会将被试对中第2个被试的 condition1 和 condition2的数据交换，condition3 和 condition4的数据交换。原因如下：
Eprime 程序中 Mark 设置为 condition1 为 左侧-红色刺激，condition2为 右侧-绿色刺激，condition3为 右侧-红色刺激，condition2为 左侧-绿色刺激，因此交换后被试对中两名对应的一致性和反应性相符。

Step15. 切分通道

新建一个宏程序，粘贴下面代码

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
'切分通道
Sub 组内切分通道()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim rngData As Range
    Dim cell As Range
    Dim filterValue As Variant
    Dim dict As Object
    Dim key As Variant
    
    ' 1. 选择要执行的工作簿，将输入的工作簿第2个工作表设置为活动表
    Set wbSource = Workbooks.Open(Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm"))
    Set wsSource = wbSource.Worksheets(2)
    wsSource.Activate
    
    ' 2. 根据第2列值筛选表格数据
    Set rngData = wsSource.Range("A1").CurrentRegion
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' a. 重复值只筛选一次，空白值不筛选，从第2列第2个单元格开始筛选
    For Each cell In rngData.Columns(2).Cells
        If cell.Row > 1 And Not IsEmpty(cell.Value) Then
            dict(cell.Value) = 1
        End If
    Next cell
    
    ' b. 根据筛选值创建新表，表名字为筛选值
    ' c. 将筛选后的值保存到对应名字的新表中
    ' d. 筛选结束后取消筛选
    Application.ScreenUpdating = False
    For Each key In dict.keys
        wsSource.Rows(1).AutoFilter Field:=2, Criteria1:=key
        Set wsNew = wbSource.Worksheets.Add(After:=wbSource.Worksheets(wbSource.Worksheets.Count))
        wsNew.Name = key
        rngData.SpecialCells(xlCellTypeVisible).Copy Destination:=wsNew.Range("A1")
        wsSource.Rows(1).AutoFilter
    Next key
    
    ' 3. 删除第1个和第二个工作表
    Application.DisplayAlerts = False
    wbSource.Worksheets(1).Delete
    wsSource.Delete
    Application.DisplayAlerts = True
    
    ' 4. 将剩余工作表中第2列删除
    For Each wsNew In wbSource.Worksheets
        wsNew.Columns(2).Delete
    Next wsNew
    
    ' 5. 保存工作簿到当前工作簿下
    wbSource.SaveAs wbSource.Path & "\" & Left(wbSource.Name, InStrRev(wbSource.Name, ".") - 1) & "_split"
    Application.ScreenUpdating = True
    MsgBox "操作完成"
End Sub

wbSource.SaveAs 

选择 Step14 后的文件路径后执行

Step16. 平均 `run`

新建一个宏程序保存下面代码：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub AverageRuns()
    Dim originalWorkbook As Workbook
    Dim newWorkbook As Workbook
    Dim originalWorksheet As Worksheet
    Dim newWorksheet As Worksheet
    Dim runCount As Integer
    Dim rowCount As Integer
    Dim colCount As Integer
    Dim currentRow As Integer
    Dim currentCol As Integer
    Dim sum As Double
    Dim count As Integer
    Dim average As Double
    
    '获取当前活动的工作簿'
    Set originalWorkbook = ActiveWorkbook
    
    '通过对话框获取run次数'
    runCount = InputBox("请输入run次数:", "输入run次数")
    
    '创建一个新的工作簿，用于保存平均后的结果'
    Set newWorkbook = Workbooks.Add
    
    '循环处理每个工作表'
    For Each originalWorksheet In originalWorkbook.Worksheets
        '添加一个新的工作表，并将名称设置为原名称+_average'
        Set newWorksheet = newWorkbook.Worksheets.Add(After:=newWorkbook.Worksheets(newWorkbook.Worksheets.Count))
        newWorksheet.Name = originalWorksheet.Name & "_average"
        
        '获取行数和列数'
        rowCount = originalWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
        colCount = originalWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
        
        '添加行标题'
        For currentCol = 2 To colCount
            newWorksheet.Cells(1, currentCol).Value = originalWorksheet.Cells(1, currentCol)
        Next currentCol
        
        '添加列标题并计算每个被试每个通道的均值'
        currentRow = 2
        For i = 2 To rowCount Step runCount
            newWorksheet.Cells(currentRow, 1).Value = Left(originalWorksheet.Cells(2 + runCount * (currentRow - 2), 1), 6)
            For currentCol = 2 To colCount
                sum = 0
                count = 0
                For k = i To i + runCount - 1
                    If Not IsEmpty(originalWorksheet.Cells(k, currentCol)) Then
                        If originalWorksheet.Cells(k,currentCol) <> 0 Then
                            sum = sum + CDbl(originalWorksheet.Cells(k, currentCol).Value)
                            count = count + 1
                        End If
                    End If
                Next k
                If count > 0 Then
                    average = sum / count
                Else
                    average = 0
                End If
                newWorksheet.Cells(currentRow, currentCol).Value = average
            Next currentCol
            currentRow = currentRow + 1
        Next i
    Next originalWorksheet

    '保存新的工作簿到当前文件夹下'
    newWorkbook.SaveAs originalWorkbook.Path & "\" & originalWorkbook.Name & "_average.xlsx"
    newWorkbook.Close SaveChanges:=True
End Sub

将需要处理的文件放到一个文件夹内，并打开第一个文件的第一个工作表
运行程序，输入run的次数

程序运行结束后可将16步的结果文件导入到 SPSS 进行重复测量方差分析。

脑间同步（Inter-brain neural synchronization ）

Step01 - Step09

与脑内激活处理步骤相同，可直接使用脑内 Step 09 结果进行脑间 Step10 操作

Step10. 分离条件

输入基线校正和Z分数转换后的数据路径
选择程序 Data Cut (mode2)
结束后不会生成新的文件

Step11. 将所有被试数据按条件整合

输入包含 Data Cut(mode2)目标文件的路径
输入保存文件的目标路径
输入文件名保存不同实验条件的平均脑激活数据，Condition1/2/3/4，并选择相应的Sheet number，第1个条件在 Sheet1，以此类推
选择程序 Gather the files，按 Set 并 Start

Step12. 将所有被试数据集中到一个 Sheet

输入包含Condition文件目标文件的路径
选择程序 Data Gather(mode2)
按 Set 并 Start

Step13. 计算基于 INS 的相关矩阵

此步骤会计算出被试对中两名被试的激活值之间的相关，包括同对伪时间序列的相关矩阵

输入 Step12 后的文件路径
选择程序 Correlation Cal，按 Set 并 Start

Step14. 提取相关数据

此步骤后需要自定义宏程序

在个人宏工作簿新建一个宏程序，输入如下代码：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit

Sub 组间提取相关数据()
    Dim folderPath As String
    Dim fileName As String
    Dim wbSource As Workbook, wbNew As Workbook
    Dim wsSource As Worksheet, wsTrueCol As Worksheet, wsPesudoCol As Worksheet
    Dim cellCorrMatrix As Range, cellPseudoCorrMatrix As Range
    Dim startCell As Range
    Dim i As Long, j As Long
    Dim newRowTrue As Long, newRowPesudo As Long
    
    ' 选择目录
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    ' 遍历目录下的所有工作簿
    fileName = Dir(folderPath & "*.xls*")
    Application.ScreenUpdating = False
    Do While fileName <> ""
        Set wbSource = Workbooks.Open(folderPath & fileName)
        
        ' 创建新工作簿并命名工作表
        Set wbNew = Workbooks.Add
        Set wsTrueCol = wbNew.Worksheets(1)
        wsTrueCol.Name = "True_Col"
        Set wsPesudoCol = wbNew.Worksheets.Add(After:=wsTrueCol)
        wsPesudoCol.Name = "Pesudo_Col"
        newRowTrue = 2
        newRowPesudo = 2
        
        
        
        ' 遍历原始工作簿的所有工作表
        For Each wsSource In wbSource.Worksheets
            Set cellCorrMatrix = wsSource.Cells.Find("Correlation matrix")
            Set cellPseudoCorrMatrix = wsSource.Cells.Find("Correlation matrix (pseudo)")

            chCounts = Application.WorksheetFunction.CountA(wsSource.Rows(1)) \ 2
            wsSource.Rows(1).Cells(1).Resize(, chCounts).Copy Destination:=wsTrueCol.Cells(1, 2)
            wsSource.Rows(1).Cells(1).Resize(, chCounts).Copy Destination:=wsPesudoCol.Cells(1, 2)
            
            ' 提取相关值
            If Not cellCorrMatrix Is Nothing Then
                Set startCell = cellCorrMatrix.Offset(50, 1)
                
                For i = 0 To chCounts - 1
                'i = 0
                'Do While Not IsEmpty(startCell.Offset(i, i))
                    wsTrueCol.Cells(newRowTrue, i + 2).Value = startCell.Offset(i, i).Value
                    wsTrueCol.Cells(newRowTrue, 1).Value = Left(wsSource.Name, 11)
                    'i = i + 1
                'Loop
                Next i
                newRowTrue = newRowTrue + 1
            End If
            
            ' 提取伪相关值
            If Not cellPseudoCorrMatrix Is Nothing Then
                Set startCell = cellPseudoCorrMatrix.Offset(50, 1)
                'j = 0
                'Do While Not IsEmpty(startCell.Offset(j, j))
                For j = 0 To chCounts - 1
                    wsPesudoCol.Cells(newRowPesudo, j + 2).Value = startCell.Offset(j, j).Value
                    wsPesudoCol.Cells(newRowPesudo, 1).Value = Left(wsSource.Name, 11)
                    'j = j + 1
                'Loop
                Next j
                newRowPesudo = newRowPesudo + 1
            End If
        Next wsSource
        
        ' 保存新工作簿
        wbNew.SaveAs folderPath & Left(wbSource.Name, InStrRev(wbSource.Name, ".") - 1) & "_ColExt.xlsx"
        wbNew.Close SaveChanges:=False
        wbSource.Close SaveChanges:=False
        fileName = Dir
    Loop
    
    Application.ScreenUpdating = True
    MsgBox "提取相关数据完成！"
End Sub

运行宏程序，选择上一步结果的路径

Step15. 平均 run

与脑内步骤一致，将需要处理的文件放到一个文件夹内
打开第1个文件第1个工作表，运行宏程序

Step16. 配对样本 t 检验

对所有通道的脑间相关数据与伪随机数据进行配对样本T检验，这里使用 R 进行

将 Step15后的数据放到一个文件夹
建立一个文本文件，输入如下代码保存，并将文件后缀改为 .r

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
# # 安装需要的包
if (!require(readxl)) install.packages("readxl")
if (!require(writexl)) install.packages("writexl")
if (!require(tidyverse)) install.packages("tidyverse")
if (!require(effsize)) install.packages("effsize")
#if (!require(lsr)) install.packages("lsr")
library(readxl)
library(writexl)
library(tidyverse)
library(effsize)
#library(lsr)
# 程序名称为"t检验"
t_test <- function() {
  # 选取工作目录
  setwd(choose.dir())
  
  # 选取目录下所有excel工作簿循环执行程序
  files <- list.files(path = getwd(), pattern = "\\.xlsx$", full.names = TRUE)
  ttest_result_list <- list()
  
  for (file in files) {
    # 读取工作簿内的两个工作表
    sheet1 <- read_excel(file, sheet = 1)
    sheet2 <- read_excel(file, sheet = 2)
    
    # 初始化结果数据框
    ttest_res <- data.frame(Column = character(), p = numeric(), t = numeric(), d = numeric(), stringsAsFactors = FALSE)
    
    # 从第2列开始进行t检验和Cohen's d计算
    for (col_idx in 2:ncol(sheet1)) {
      data1 <- sheet1[-1, col_idx]
      data2 <- sheet2[-1, col_idx]
      data1_num <- as.matrix(data1)
      data2_num <- as.matrix(data2)
      ttest <- t.test(data1_num, data2_num, paired = TRUE, var.equal = TRUE, conf.level = 0.95)

      cohen_d <- cohen.d(data1_num, data2_num)
      
      ttest_res <- rbind(ttest_res, data.frame(Column = colnames(sheet1)[col_idx], p = ttest$p.value, t = ttest$statistic, d = abs(cohen_d$estimate), stringsAsFactors = FALSE))
    }
    filename <- sub(".xlsx", "", basename(file))
    
    # 将每一个工作簿的结果保存至ttest_result对应的工作表内，名称为执行程序的工作簿的名称
    ttest_result_list[[filename]] <- ttest_res
  }
  
  # 将每一次t检验的结果输出至一个新的工作簿，名称为"ttest_result"保存在当前目录下
  write_xlsx(ttest_result_list, "ttest_result.xlsx")
  infoMes <- "检验完成!"
  print(infoMes)
}

# 运行t检验程序
t_test()

打开 R，点击 文件---运行 r 脚本文件，选择刚才的代码文件运行

Step17. 切分通道

选择 Step15 运行后的结果文件路径，注意是第15步
新建一个宏程序，粘贴如下代码，并运行：

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Option Explicit

Sub 组间切分通道()
    Dim fDialog As FileDialog, sFolderPath As String
    Dim oFSO As Object, oFolder As Object, oFile As Object
    Dim oOriginalWorkbook As Workbook, oNewWorkbook As Workbook
    Dim oOriginalWorksheet As Worksheet, oNewWorksheet As Worksheet
    Dim lLastCol As Long, lLastRow As Long, i As Long, j As Long, k As Long
    Dim sFileName As String, sSheetName As String
    
    ' 选择文件夹
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    fDialog.Title = "选择工作目录"
    fDialog.AllowMultiSelect = False
    If fDialog.Show <> -1 Then Exit Sub
    sFolderPath = fDialog.SelectedItems(1)
    Application.ScreenUpdating = False
    '创建结果文件夹
    MkDir sFolderPath & "\result"
    ' 创建新工作簿 "all_condition_split"
    Set oNewWorkbook = Workbooks.Add
    oNewWorkbook.SaveAs sFolderPath & "\result" & "\" & "all_condition_split.xlsx"
    
   ' 遍历工作目录下的所有Excel文件
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sFolderPath)
    k = 1
    For Each oFile In oFolder.Files
        If oFSO.GetExtensionName(oFile.Name) = "xlsx" Or oFSO.GetExtensionName(oFile.Name) = "xls" Then
            If oFile.Name <> "all_condition_split.xlsx" Then
                ' 打开原始工作簿
                Set oOriginalWorkbook = Workbooks.Open(oFile.Path)
                Set oOriginalWorksheet = oOriginalWorkbook.Worksheets(2)
                
                ' 新建工作表
                If k = 1 Then
                    lLastCol = oOriginalWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column
                    For i = 2 To lLastCol
                        sSheetName = oOriginalWorksheet.Cells(1, i).Value
                        Set oNewWorksheet = oNewWorkbook.Worksheets.Add(, oNewWorkbook.Worksheets(oNewWorkbook.Worksheets.Count))
                        oNewWorksheet.Name = sSheetName
                        oNewWorksheet.Cells(1, 1).Value = oOriginalWorksheet.Cells(1, 1).Value
                    Next i
                End If
                
                ' 复制数据到新工作簿
                For i = 2 To lLastCol
                    Set oNewWorksheet = oNewWorkbook.Worksheets(i)
                    lLastRow = oOriginalWorksheet.Cells(Rows.Count, i).End(xlUp).Row
                    oOriginalWorksheet.Range(oOriginalWorksheet.Cells(2, i), oOriginalWorksheet.Cells(lLastRow, i)).Copy oNewWorksheet.Cells(2, k + 1)
                    oNewWorksheet.Cells(1, k + 1).Value = Split(oFile.Name, "_")(0)
                    
                    ' 复制第一列数据到新工作簿
                    oOriginalWorksheet.Range(oOriginalWorksheet.Cells(2, 1), oOriginalWorksheet.Cells(lLastRow, 1)).Copy oNewWorksheet.Cells(2, 1)
                Next i
                
                k = k + 1
                oOriginalWorkbook.Close False
            End If
        End If
    Next oFile
    
    ' 保存新工作簿
    oNewWorkbook.Save
    oNewWorkbook.Close
    
    ' 打开 "all_condition_split" 工作簿
    Set oNewWorkbook = Workbooks.Open(sFolderPath & "\result" & "\" & "all_condition_split.xlsx")
    
    ' 循环操作每个工作表
    For Each oNewWorksheet In oNewWorkbook.Worksheets
        lLastRow = oNewWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
        oNewWorksheet.Range(oNewWorksheet.Cells(2, 3), oNewWorksheet.Cells(lLastRow, 3)).Copy oNewWorksheet.Cells(lLastRow + 1, 2)
        oNewWorksheet.Range(oNewWorksheet.Cells(2, 5), oNewWorksheet.Cells(lLastRow, 5)).Copy oNewWorksheet.Cells(lLastRow + 1, 4)
        oNewWorksheet.Range(oNewWorksheet.Cells(2, 1), oNewWorksheet.Cells(lLastRow, 1)).Copy oNewWorksheet.Cells(lLastRow + 1, 1)
        
        ' 删除第3列和第5列
        oNewWorksheet.Columns(5).Delete
        oNewWorksheet.Columns(3).Delete
    Next oNewWorksheet
    
    ' 保存修改并关闭
    oNewWorkbook.Save
    oNewWorkbook.Close
    Application.ScreenUpdating = True
    MsgBox "切分通道完成，结果保存在当前文件夹 result 目录下!"
    
End Sub

程序运行结束后可将17步的结果文件导入到 SPSS 进行重复测量方差分析。

fNIRS Data Preprocessing使用步骤#

fNIRS Data Preprocessing 宏程序介绍#

脑内激活（Intra-brain activation）#

Step01. Hitachi#

Step02. Trigger Check#

Step03. 格式转换 xlsx to mat#

Step04. 带通滤波(bandpass-filter)#

Step05. 将 txt 格式转为 xlsx 文件#

Step06. 提取行为数据#

Step07. 整合行为数据#

Step08. 添加 Mark#

Step09. 基线校正和Z分数转换#

Step10. 分离条件#

Step11. 计算平均脑激活#

Step12. 将所有被试数据按条件整合#

Step13. 将所有被试数据集中到一个 Sheet#

Step14. 整合条件#

Step15. 切分通道#

Step16. 平均 run#

脑间同步（Inter-brain neural synchronization ）#

Step01 - Step09#

Step10. 分离条件#

Step11. 将所有被试数据按条件整合#

Step12. 将所有被试数据集中到一个 Sheet#

Step13. 计算基于 INS 的相关矩阵#

Step14. 提取相关数据#

Step15. 平均 run#

Step16. 配对样本 t 检验#

Step17. 切分通道#

fNIRS Data Preprocessing使用步骤

fNIRS Data Preprocessing 宏程序介绍

脑内激活（Intra-brain activation）

Step01. Hitachi

Step02. Trigger Check

Step03. 格式转换 xlsx to mat

Step04. 带通滤波(bandpass-filter)

Step05. 将 `txt` 格式转为 `xlsx` 文件

Step06. 提取行为数据

Step07. 整合行为数据

Step08. 添加 `Mark`

Step09. 基线校正和Z分数转换

Step10. 分离条件

Step11. 计算平均脑激活

Step12. 将所有被试数据按条件整合

Step13. 将所有被试数据集中到一个 Sheet

Step14. 整合条件

Step15. 切分通道

Step16. 平均 `run`

脑间同步（Inter-brain neural synchronization ）

Step01 - Step09

Step10. 分离条件

Step11. 将所有被试数据按条件整合

Step12. 将所有被试数据集中到一个 Sheet

Step13. 计算基于 INS 的相关矩阵

Step14. 提取相关数据

Step15. 平均 run

Step16. 配对样本 t 检验

Step17. 切分通道