Hackerrank--String Function Calculation(后缀数组)

本文介绍了一种解决字符串问题的方法,通过构建后缀数组和最长公共前缀(LCP)数组,来找到字符串所有子串中特定函数的最大值。此函数定义为子串的长度与其在原字符串中出现次数的乘积。

题目链接

Jane loves string more than anything. She made a function related to the string some days ago and forgot about it. She is now confused about calculating the value of this function. She has a string T with her, and value of string S over function f can be calculated as given below:

f(S)=|S|NumberoftimesSoccuringinT

Jane wants to know the maximum value of f(S) among all the substrings (S) of string T. Can you help her?

Input Format
A single line containing string T in small letter('a' - 'z').

Output Format
An integer containing the value of output.

Constraints
1 ≤|T|≤ 105

Sample Input #00

aaaaaa

Sample Output #00

12

Explanation #00

f('a') = 6
f('aa') = 10
f('aaa') = 12
f('aaaa') = 12
f('aaaaa') = 10
f('aaaaaa') = 6

Sample Input #01

abcabcddd

Sample Output #01

9

Explanation #01

f("a") = 2
f("b") = 2
f("c") = 2
f("ab") = 4
f("bc") = 4
f("ddd") = 3
f("abc") = 6
f("abcabcddd") = 9

Among the function values 9 is the maximum one.

题意:求字符串所有子串中,f(s)的最大值。这里s是某个子串,f(s) = s的长度与s在原字符串中出现次数的乘积。

求得lcp, 转化为求以lcp为高的最大子矩形。

Accepted Code:

 1 #include <string>
 2 #include <iostream>
 3 #include <algorithm>
 4 using namespace std;
 5 
 6 const int MAX_N = 100002;
 7 int sa[MAX_N], rk[MAX_N], lcp[MAX_N], tmp[MAX_N], n, k;
 8 
 9 bool compare_sa(int i, int j) {
10     if (rk[i] != rk[j]) return rk[i] < rk[j];
11     int ri = i + k <= n ? rk[i + k] : -1;
12     int rj = j + k <= n ? rk[j + k] : -1;
13     return ri < rj;
14 }
15 
16 void construct_sa(const string &S, int *sa) {
17     n = S.length();
18     for (int i = 0; i <= n; i++) {
19         sa[i] = i;
20         rk[i] = i < n ? S[i] : -1;
21     }
22     
23     for (k = 1; k <= n; k *= 2) {
24         sort(sa, sa + n + 1, compare_sa);
25         
26         tmp[sa[0]] = 0;
27         for (int i = 1; i <= n; i++) {
28             tmp[sa[i]] = tmp[sa[i - 1]] + (compare_sa(sa[i - 1], sa[i]) ? 1 : 0);
29         }
30         for (int i = 0; i <= n; i++) rk[i] = tmp[i];
31     }
32 }
33 
34 void construct_lcp(const string &S, int *sa, int *lcp) {
35     n = S.length();
36     for (int i = 0; i <= n; i++) rk[sa[i]] = i;
37     
38     int h = 0;
39     lcp[0] = 0;
40     for (int i = 0; i < n; i++) {
41         int j = sa[rk[i] - 1];
42         
43         if (h > 0) h--;
44         for (; i + h < n && j + h < n; h++) if (S[i + h] != S[j + h]) break;
45             
46         lcp[rk[i] - 1] = h;
47     }
48 }
49 
50 string S;
51 int lft[MAX_N], rgt[MAX_N], st[MAX_N], top;
52 void solve() {
53     construct_sa(S, sa);
54     construct_lcp(S, sa, lcp);
55     
56     lcp[n] = n - sa[n];
57    // for (int i = 1; i <= n; i++) cerr << lcp[i] << ' ';
58    // cerr << endl;
59     top = 0;
60     for (int i = 1; i <= n; i++) {
61         while (top && lcp[st[top-1]] >= lcp[i]) top--;
62         if (top) lft[i] = st[top - 1] + 1;
63         else lft[i] = 1;
64         st[top++] = i;
65     }
66     top = 0;
67     for (int i = n; i > 0; i--) {
68         while (top && lcp[st[top-1]] >= lcp[i]) top--;
69         // attention: rgt[i] should be asigned to st[top - 1]
70         // rather than st[top - 1] - 1 because lcp[i] is the
71         // length of the longest common prefix of sa[i] and sa[i + 1]. 
72         if (top) rgt[i] = st[top - 1];
73         else rgt[i] = n;
74         st[top++] = i;
75     }
76     long long ans = n;
77     for (int i = 1; i <= n; i++) ans = max(ans, (long long)lcp[i] * (rgt[i] - lft[i] + 1));
78     cout << ans << endl;
79 }
80 
81 int main(void) {
82     //ios::sync_with_std(false);
83     while (cin >> S) solve();
84     return 0;
85 }

 

转载于:https://www.cnblogs.com/Stomach-ache/p/3930096.html

#define _CRT_SECURE_NO_WARNINGS #include <stdio.h> #include “aip_common.h” #include <string.h> #include <stdlib.h> #define ZERO (0) #define MAX_LINE_LENGTH (256) #define ADD_VALUE (0xF) #define FALSE (0) #define WRONG (1) #define SUCCESS (1) #define TRUE (1) #define STORESIZE (9) #define ENDOFSTRING (8) #define FOUR (4) /* / / Display Application : Main Processing Task / / ---------------------------------------------------------------------------------------------------------------------------------/ / Function: main / / Description: This function processes DA_510B_IMG_1.mhx file to extract address values, applies offset calculation, / / and generates WRITE_ADDRESS.TXT output file with formatted address pairs. / / Arguments: void / / Return: U4 - Process execution status (ZERO for success, WRONG for failure) / /=/ U4 main(void) { U4 u4_t_search_target; FILE stp_t_creatfile_da_510b_img_1; FILE* stp_t_creatfile_write_address; U1 u1_t_p_test_line[MAX_LINE_LENGTH]; size_t u4_t_test_len; U1* u1p_t_s315_pos; U1* u1p_t_addr_start; U1 u1_t_p_test_new_hex_addr[STORESIZE]; U4 u4_t_test_address; U4 u4_t_test_new_address; S4 s4_tp_store_string[STORESIZE] = { ZERO }; U4 u4_t_return_value = ZERO; /* Unified return status variable */ u4_t_search_target =(U4) FALSE; stp_t_creatfile_da_510b_img_1 = NULL; stp_t_creatfile_write_address = NULL; u1p_t_s315_pos = NULL; u1p_t_addr_start = NULL; u4_t_test_address = (U4)ZERO; u4_t_test_new_address = (U4)ZERO; /* Open input file for reading / stp_t_creatfile_da_510b_img_1 = fopen(“DA_510B_IMG_1.mhx”, “rb”); / Handle input file open failure / if (NULL == stp_t_creatfile_da_510b_img_1) { printf(“Input file open failed\n”); u4_t_return_value = (U4)WRONG; } else { / Create output file for writing / stp_t_creatfile_write_address = fopen(“WRITE_ADDRESS.TXT”, “w”); / Handle output file creation failure / if (NULL == stp_t_creatfile_write_address) { printf(“Output file creation failed\n”); fclose(stp_t_creatfile_da_510b_img_1); u4_t_return_value = (U4)WRONG; } else { printf(“Input file opened successfully\n”); / Process each line in input file / while (fgets(u1_t_p_test_line, (U4)MAX_LINE_LENGTH, stp_t_creatfile_da_510b_img_1) != NULL) { / Remove newline character from line end / u4_t_test_len = strlen(u1_t_p_test_line); if (u4_t_test_len > 0 && u1_t_p_test_line[u4_t_test_len - 1] == ‘\n’) { u1_t_p_test_line[u4_t_test_len - 1] = ‘\0’; } / Search for “S315” marker in current line / u1p_t_s315_pos = strstr(u1_t_p_test_line, “S315”); / Process line containing target marker / if (u1p_t_s315_pos != NULL) { printf(“Target line found: %s\n”, u1_t_p_test_line); u1p_t_addr_start = u1p_t_s315_pos + (U4)FOUR; / Verify sufficient characters after marker / if (strlen(u1p_t_addr_start) >= (U4)ENDOFSTRING) { / Extract and store address string / strncpy(s4_tp_store_string, u1p_t_addr_start, (U4)ENDOFSTRING); s4_tp_store_string[(U4)ENDOFSTRING] = ‘\0’; printf(“Raw hexadecimal address: %p\n”, s4_tp_store_string); / Convert hex string to numeric value / u4_t_test_address = strtoul(s4_tp_store_string, NULL, 16); / Apply address offset calculation / u4_t_test_new_address = u4_t_test_address + ADD_VALUE; / Format new address as 8-digit hex string / snprintf(u1_t_p_test_new_hex_addr, sizeof(u1_t_p_test_new_hex_addr), “%08lX”, u4_t_test_new_address); printf(“Address after adding 16: 0x%s\n”, u1_t_p_test_new_hex_addr); / Write formatted address pair to output file / fprintf(stp_t_creatfile_write_address, “0x40000000,0x%s\n”, u1_t_p_test_new_hex_addr); fprintf(stp_t_creatfile_write_address, “0x43FFFFF0,0x43FFFFFF\n”); printf(“File written successfully: WRITE_ADDRESS.TXT\n”); u4_t_search_target = (U4)SUCCESS; } else { printf(“Error: Characters after S315 less than 8\n”); } break; } } / Handle case where target marker was not found / if (!u4_t_search_target) { printf(“line S315 not found\n”); / Write default address format to output file / fprintf(stp_t_creatfile_write_address, “0x40000000,0x00000000\n”); fprintf(stp_t_creatfile_write_address, “0x43FFFFF0,0x43FFFFFF\n”); printf(“Default format written to file\n”); } / Close output file handle / fclose(stp_t_creatfile_write_address); } / Close input file handle */ fclose(stp_t_creatfile_da_510b_img_1); } system(“pause”); return u4_t_return_value; }帮我把main函数里面函数功能封装到不同函数中,按照我的编码习惯
07-31
为什么现在点击更新Dashboard的时候会报错:创建数据透视表时出错:不能设置类PivotField的Name属性,但是生成的Dashboard是没有问题的 ' ===== 主记录过程 ===== Public Sub RecordHistory() Dim wsSchedule As Worksheet Dim wsHistory As Worksheet Dim lastRowSchedule As Long Dim lastRowHistory As Long Dim partialDictModules As Object Dim partialDictGroups As Object Dim allDictModules As Object Dim allDictGroups As Object Dim cell As Range Dim key As Variant Dim updateDate As Date Dim count As Integer Dim existingDateRow As Long Dim i As Long Dim rowsToDelete As Collection Dim scheduleUpdateDate As Date Dim buttonExists As Boolean Dim buttonPosition As Range Dim status As String Dim moduleName As String Dim groupName As String Dim shp As Shape buttonExists = False On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set wsSchedule = ThisWorkbook.Sheets("schedule") If Not WorksheetExists("HistoryStorage") Then Set wsHistory = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)) wsHistory.Name = "HistoryStorage" wsHistory.Range("A1:E1").value = Array("记录日期", "名称", "数量", "类型", "状态类型") wsHistory.Range("A1:E1").Font.Bold = True wsHistory.Columns("A").NumberFormat = "yyyy-mm-dd" wsHistory.Columns("C").NumberFormat = "0" Else Set wsHistory = ThisWorkbook.Sheets("HistoryStorage") ' 检查按钮是否存在并记录位置 On Error Resume Next Set buttonPosition = Nothing For Each shp In wsHistory.Shapes If shp.Type = msoFormControl And shp.FormControlType = xlButtonControl Then Set buttonPosition = shp.TopLeftCell buttonExists = True Exit For End If Next shp On Error GoTo 0 End If scheduleUpdateDate = GetScheduleUpdateDate(wsSchedule) If scheduleUpdateDate = 0 Then updateDate = Date MsgBox "无法从schedule表获取有效日期", vbExclamation Else updateDate = DateValue(scheduleUpdateDate) End If ' 创建字典存储部分状态数据 Set partialDictModules = CreateObject("Scripting.Dictionary") Set partialDictGroups = CreateObject("Scripting.Dictionary") ' 创建字典存储全部状态数据 Set allDictModules = CreateObject("Scripting.Dictionary") Set allDictGroups = CreateObject("Scripting.Dictionary") lastRowSchedule = wsSchedule.Cells(wsSchedule.rows.count, "D").End(xlUp).row ' 收集数据 For Each cell In wsSchedule.Range("D2:D" & lastRowSchedule) status = Trim(UCase(wsSchedule.Cells(cell.row, "G").value)) moduleName = cell.value groupName = Trim(wsSchedule.Cells(cell.row, "J").value) ' 收集全部状态数据 If moduleName <> "" Then ' 模块统计 allDictModules(moduleName) = allDictModules(moduleName) + 1 ' 责任组统计 If groupName <> "" Then allDictGroups(groupName) = allDictGroups(groupName) + 1 End If End If ' 收集部分状态数据 If moduleName <> "" And _ (status = "ASSIGNED" Or _ status = "OPEN" Or _ status = "NEW") Then ' 模块统计 partialDictModules(moduleName) = partialDictModules(moduleName) + 1 ' 责任组统计 If groupName <> "" Then partialDictGroups(groupName) = partialDictGroups(groupName) + 1 End If End If Next cell lastRowHistory = wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row If wsHistory.Range("A1").value = "" Or wsHistory.Range("A1").value <> "记录日期" Then wsHistory.Range("A1:E1").value = Array("记录日期", "名称", "数量", "类型", "状态类型") wsHistory.Range("A1:E1").Font.Bold = True wsHistory.Columns("A").NumberFormat = "yyyy-mm-dd" wsHistory.Columns("C").NumberFormat = "0" End If Set rowsToDelete = New Collection If lastRowHistory > 1 Then For i = 2 To lastRowHistory ' 跳过按钮所在行 If buttonExists Then If i = buttonPosition.row Then GoTo SkipRow End If If IsDate(wsHistory.Cells(i, "A").value) Then If DateValue(wsHistory.Cells(i, "A").value) = updateDate Then rowsToDelete.Add i End If End If SkipRow: Next i End If If rowsToDelete.count > 0 Then For i = rowsToDelete.count To 1 Step -1 wsHistory.rows(rowsToDelete(i)).Delete Next i lastRowHistory = wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row End If If lastRowHistory = 1 Then lastRowHistory = 2 Else lastRowHistory = lastRowHistory + 1 End If ' 写入部分状态数据 WriteHistoryData wsHistory, lastRowHistory, updateDate, partialDictModules, "模块", "未解决状态" lastRowHistory = wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row + 1 WriteHistoryData wsHistory, lastRowHistory, updateDate, partialDictGroups, "责任组", "未解决状态" lastRowHistory = wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row + 1 ' 写入全部状态数据 WriteHistoryData wsHistory, lastRowHistory, updateDate, allDictModules, "模块", "全部状态" lastRowHistory = wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row + 1 WriteHistoryData wsHistory, lastRowHistory, updateDate, allDictGroups, "责任组", "全部状态" ' 调整列表对象范围到E列 On Error Resume Next If wsHistory.ListObjects.count = 0 Then wsHistory.Range("A1:E" & wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row).Select wsHistory.ListObjects.Add(xlSrcRange, Selection, , xlYes).Name = "HistoryStorage" Else wsHistory.ListObjects("HistoryStorage").Resize wsHistory.Range("A1:E" & wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row) End If On Error GoTo 0 wsHistory.Columns("A:E").AutoFit Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Exit Sub ErrorHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "运行时错误:" & Err.Description, vbCritical End Sub ' ===== 新增辅助函数:写入历史数据 ===== Private Sub WriteHistoryData(ws As Worksheet, startRow As Long, recordDate As Date, dict As Object, dataType As String, statusType As String) Dim key As Variant For Each key In dict.keys ws.Cells(startRow, "A").value = recordDate ws.Cells(startRow, "B").value = key ws.Cells(startRow, "C").value = dict(key) ws.Cells(startRow, "D").value = dataType ws.Cells(startRow, "E").value = statusType ' 状态类型列 startRow = startRow + 1 Next key End Sub ' ===== 仪表板创建过程 ===== Public Sub CreateEnhancedHistoryChart() Dim wsHistory As Worksheet Dim wsDashboard As Worksheet Dim pivotTableCache As PivotCache Dim pivotTable As pivotTable Dim lastRow As Long Dim pivotRange As Range Dim chartType As Integer Dim dataField As String Dim chartTitle As String Dim pivotCreated As Boolean ' 字段名称变量 Dim dateFieldName As String Dim itemFieldName As String Dim countFieldName As String Dim typeFieldName As String Dim statusFieldName As String On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.EnableEvents = False ' 检查HistoryStorage表是否存在 If Not WorksheetExists("HistoryStorage") Then MsgBox "HistoryStorage表不存在,请先运行记录历史功能", vbExclamation Exit Sub End If ' === 添加状态类型选择 === Dim statusType As Integer statusType = Application.InputBox("请选择要显示的状态类型:" & vbCrLf & _ "1 - 未解决状态 (ASSIGNED/OPEN/NEW)" & vbCrLf & _ "2 - 全部状态" & vbCrLf & _ "3 - 同时显示两种状态", _ "状态类型选择", 1, Type:=1) ' 验证用户选择 If statusType = 0 Then MsgBox "操作已取消", vbInformation Exit Sub ElseIf statusType < 1 Or statusType > 3 Then MsgBox "无效的选择,请输入1、2或3", vbExclamation Exit Sub End If ' === 添加图表类型选择 === chartType = Application.InputBox("请选择要显示的图表类型:" & vbCrLf & _ "1 - 模块名称" & vbCrLf & _ "2 - 责任组" & vbCrLf & _ "3 - 全部数据", _ "图表类型选择", 1, Type:=1) ' 验证用户选择 If chartType = 0 Then MsgBox "操作已取消", vbInformation Exit Sub ElseIf chartType < 1 Or chartType > 3 Then MsgBox "无效的选择,请输入1、2或3", vbExclamation Exit Sub End If ' 根据用户选择设置参数 Select Case chartType Case 1 ' 仅模块 dataField = "模块" chartTitle = "模块数量历史趋势" Case 2 ' 仅责任组 dataField = "责任组" chartTitle = "责任组数量历史趋势" Case 3 ' 全部 dataField = "" chartTitle = "综合数据历史趋势" End Select ' 添加状态类型到标题 Select Case statusType Case 1: chartTitle = chartTitle & " (未解决状态)" Case 2: chartTitle = chartTitle & " (全部状态)" Case 3: chartTitle = chartTitle & " (全部状态类型)" End Select Set wsHistory = ThisWorkbook.Sheets("HistoryStorage") ' 获取字段名称 dateFieldName = GetValidFieldName(wsHistory, "A") itemFieldName = GetValidFieldName(wsHistory, "B") countFieldName = GetValidFieldName(wsHistory, "C") typeFieldName = GetValidFieldName(wsHistory, "D") statusFieldName = GetValidFieldName(wsHistory, "E") ' 状态类型字段 ' 检查是否有足够数据 lastRow = wsHistory.Cells(wsHistory.rows.count, "A").End(xlUp).row If lastRow <= 1 Then MsgBox "历史数据表为空,请先记录数据", vbExclamation Exit Sub End If ' 创建/重置仪表板工作表 If WorksheetExists("Dashboard") Then Application.DisplayAlerts = False ThisWorkbook.Sheets("Dashboard").Delete Application.DisplayAlerts = True End If Set wsDashboard = ThisWorkbook.Sheets.Add(After:=wsHistory) wsDashboard.Name = "Dashboard" ' === 设置简洁仪表板布局 === With wsDashboard .Range("A1").value = chartTitle .Range("A1").Font.Bold = True .Range("A1").Font.size = 20 .Range("A1").RowHeight = 35 .Columns("A:A").ColumnWidth = 20 .Columns("B:B").ColumnWidth = 35 .Columns("C:C").ColumnWidth = 15 End With ' 准备数据透视表范围 Set pivotRange = wsHistory.Range("A1:E" & lastRow) ' === 创建数据透视表 === CreatePivotTableWithAlternativeMethod wsDashboard, pivotRange, dateFieldName, _ itemFieldName, countFieldName, typeFieldName, dataField, chartType, _ chartTitle, statusFieldName, statusType ' 调整工作表视图 wsDashboard.Activate wsDashboard.Range("A1").Select CleanExit: Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub ErrorHandler: Application.ScreenUpdating = True Application.EnableEvents = True Dim errMsg As String errMsg = "创建图表时出错: " & Err.Description & vbCrLf & _ "错误号: " & Err.Number & vbCrLf & _ "发生位置: " & Erl MsgBox errMsg, vbCritical End Sub ' ===== 修复后的透视表创建方法(保留列总计问题)===== Private Sub CreatePivotTableWithAlternativeMethod(wsDashboard As Worksheet, _ pivotRange As Range, _ dateFieldName As String, _ itemFieldName As String, _ countFieldName As String, _ typeFieldName As String, _ dataField As String, _ chartType As Integer, _ chartTitle As String, _ statusFieldName As String, _ statusType As Integer) On Error GoTo ErrorHandler ' 创建透视缓存 Dim pc As PivotCache Set pc = ThisWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=pivotRange.Address(External:=True)) ' 创建数据透视表 Dim pt As pivotTable Set pt = pc.CreatePivotTable( _ TableDestination:=wsDashboard.Range("A3"), _ TableName:="SafePivot") Application.ScreenUpdating = False ' === 添加字段(关键修复)=== ' 1. 添加行字段(日期) With pt.PivotFields(dateFieldName) .orientation = xlRowField .position = 1 End With ' 2. 添加列字段(项目) With pt.PivotFields(itemFieldName) .orientation = xlColumnField .position = 1 End With ' 3. 添加数据字段(数量) With pt.PivotFields(countFieldName) .orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Name = "数量" End With ' 4. 添加筛选字段(状态类型) If statusType <> 3 Then ' 当选择3时显示全部状态 With pt.PivotFields(statusFieldName) .orientation = xlPageField .position = 1 ' 设置筛选值 If statusType = 1 Then .CurrentPage = "未解决状态" ElseIf statusType = 2 Then .CurrentPage = "全部状态" End If End With End If ' 5. 添加额外筛选字段(数据类型)- 当用户选择特定类型时 If dataField <> "" Then With pt.PivotFields(typeFieldName) .orientation = xlPageField .position = 1 .CurrentPage = dataField End With End If ' === 解决数据为空问题 === ' 强制刷新透视表 pt.RefreshTable DoEvents ' 检查是否有数据 If pt.DataBodyRange Is Nothing Then MsgBox "数据透视表创建成功,但未找到匹配数据。请检查筛选条件。", vbExclamation End If ' 调用简化版图表函数(避免复杂操作) CreateSimpleChart wsDashboard, pt, chartTitle Exit Sub ErrorHandler: MsgBox "创建数据透视表时出错: " & Err.Description, vbCritical Resume Next End Sub ' ===== 简化版图表创建 ==== Private Sub CreateSimpleChart(ws As Worksheet, pt As pivotTable, chartTitle As String) On Error Resume Next ' 确定图表位置 Dim chartTop As Long chartTop = pt.TableRange2.row + pt.TableRange2.rows.count + 2 ' 创建图表对象 Dim chtObj As ChartObject Set chtObj = ws.ChartObjects.Add( _ Left:=50, _ Top:=chartTop, _ Width:=600, _ Height:=400) Dim cht As Chart Set cht = chtObj.Chart ' 设置图表类型和标题 cht.chartType = xlLine cht.HasTitle = True cht.chartTitle.Text = chartTitle ' === 手动添加系列 === Dim srs As Series Dim col As Long ' 添加每个数据系列 For col = 1 To pt.DataBodyRange.Columns.count Set srs = cht.SeriesCollection.NewSeries With srs .Name = pt.ColumnRange.Cells(1, col).value .values = pt.DataBodyRange.Columns(col) .XValues = pt.RowRange.Offset(1).Resize(pt.DataBodyRange.rows.count) End With Next col ' 添加总计系列 Set srs = cht.SeriesCollection.NewSeries With srs .Name = "总计" .values = GetManualRowTotals(pt) .XValues = pt.RowRange.Offset(1).Resize(pt.DataBodyRange.rows.count) .Border.Color = RGB(0, 0, 255) .MarkerStyle = xlMarkerStyleSquare End With End Sub ' ===== 手动计算行总计 ==== Private Function GetManualRowTotals(pt As pivotTable) As Variant Dim dataRange As Range Dim totalValues() As Double Dim i As Long, j As Long Set dataRange = pt.DataBodyRange If dataRange Is Nothing Then ReDim totalValues(1 To 1) totalValues(1) = 0 GetManualRowTotals = totalValues Exit Function End If ReDim totalValues(1 To dataRange.rows.count) For i = 1 To dataRange.rows.count Dim rowTotal As Double rowTotal = 0 For j = 1 To dataRange.Columns.count If IsNumeric(dataRange.Cells(i, j).value) Then rowTotal = rowTotal + dataRange.Cells(i, j).value End If Next j totalValues(i) = rowTotal Next i GetManualRowTotals = totalValues End Function ' === 新增:通过XML操作仅禁用列总计 === Private Sub ForceDisablePivotColumnTotalOnly(pt As pivotTable) On Error Resume Next Dim xmlDoc As Object Dim xmlNode As Object ' 获取透视表XML Dim xml As String xml = pt.PivotTableXML ' 创建XML文档对象 Set xmlDoc = CreateObject("MSXML2.DOMDocument") xmlDoc.async = False xmlDoc.LoadXML xml ' 禁用列总计(showColGrandTotals设为0),保留行总计(showRowGrandTotals设为1) Set xmlNode = xmlDoc.SelectSingleNode("//pivotTableDefinition/showRowGrandTotals") If Not xmlNode Is Nothing Then xmlNode.Text = "1" ' 保留行总计 Set xmlNode = xmlDoc.SelectSingleNode("//pivotTableDefinition/showColGrandTotals") If Not xmlNode Is Nothing Then xmlNode.Text = "0" ' 禁用列总计 ' 应用修改后的XML pt.PivotTableXML = xmlDoc.xml ' 刷新透视表 pt.RefreshTable End Sub ' ===== 完全重写的图表创建函数 ===== Public Sub CreateEnhancedLineChart(ws As Worksheet, pt As pivotTable, chartTitle As String) On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.EnableEvents = False ' 1. 强制刷新透视表 pt.ManualUpdate = False pt.RefreshTable DoEvents ' 2. 验证透视表数据范围 If pt.TableRange2 Is Nothing Or pt.TableRange2.rows.count < 2 Then MsgBox "数据透视表没有足够的数据创建图表", vbExclamation GoTo CleanExit End If ' 3. 创建图表对象(绝对位置) Dim chtObj As ChartObject Set chtObj = ws.ChartObjects.Add(Left:=50, Top:=100, Width:=600, Height:=400) Dim cht As Chart Set cht = chtObj.Chart ' 4. 设置图表基本属性(避免使用SetSourceData) cht.chartType = xlLineMarkers cht.HasTitle = True cht.chartTitle.Text = chartTitle ' === 关键修改1:手动添加数据系列 === Dim srs As Series Dim col As Long Dim lastRow As Long lastRow = pt.DataBodyRange.rows.count ' 添加每个数据系列 For col = 1 To pt.DataBodyRange.Columns.count - 1 ' 排除总计列 Set srs = cht.SeriesCollection.NewSeries With srs .Name = pt.TableRange2.Cells(1, col + 1).value .values = pt.DataBodyRange.Columns(col) .XValues = pt.RowRange.Offset(1).Resize(lastRow) End With Next col ' === 关键修改2:安全添加行总计系列 === Dim totalValues As Variant totalValues = GetSafeRowTotalValues(pt, lastRow) If Not IsEmpty(totalValues) Then Set srs = cht.SeriesCollection.NewSeries With srs .Name = "行总计" .values = totalValues .XValues = pt.RowRange.Offset(1).Resize(lastRow) .Border.Color = RGB(0, 0, 255) .MarkerStyle = xlMarkerStyleSquare .MarkerSize = 7 End With Else MsgBox "无法获取行总计数据", vbExclamation End If ' 5. 设置图表格式 With cht .HasLegend = True .Legend.position = xlLegendPositionBottom With .Axes(xlCategory) .CategoryType = xlCategoryScale .TickLabels.orientation = xlHorizontal End With With .Axes(xlValue) .HasMajorGridlines = True .MajorGridlines.Border.Color = RGB(200, 200, 200) End With End With CleanExit: Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub ErrorHandler: ' 详细错误处理 Dim errMsg As String errMsg = "图表创建错误[" & Err.Number & "]: " & Err.Description & vbCrLf & _ "错误发生在:" & GetErrorLocation(Erl) ' 尝试基础图表作为后备方案 On Error Resume Next CreateBasicLineChart ws, pt.DataBodyRange, chartTitle On Error GoTo 0 MsgBox errMsg, vbCritical Resume CleanExit End Sub ' ===== 安全获取行总计值(带维度验证) ===== Private Function GetSafeRowTotalValues(pt As pivotTable, expectedSize As Long) As Variant On Error Resume Next Dim values() As Double Dim rowTotalRange As Range Dim i As Long ' 方法1:尝试获取总计列 Dim rowTotalCol As Long rowTotalCol = FindTotalColumn(pt, False) ' 查找行总计列 If rowTotalCol > 0 Then Set rowTotalRange = pt.DataBodyRange.Resize(, 1).Offset(, rowTotalCol - 1) ' 验证维度 If rowTotalRange.rows.count = expectedSize Then ReDim values(1 To expectedSize) For i = 1 To expectedSize values(i) = Val(rowTotalRange.Cells(i, 1).value) Next i GetSafeRowTotalValues = values Exit Function End If End If ' 方法2:手动计算总计 GetSafeRowTotalValues = CalculateManualRowTotal(pt, expectedSize) End Function ' ===== 维度安全的行总计计算 ===== Private Function CalculateManualRowTotal(pt As pivotTable, expectedSize As Long) As Variant Dim dataRange As Range Dim values() As Double Dim i As Long, j As Long Set dataRange = pt.DataBodyRange If dataRange Is Nothing Then ReDim values(1 To expectedSize) CalculateManualRowTotal = values Exit Function End If ReDim values(1 To expectedSize) For i = 1 To expectedSize Dim rowTotal As Double rowTotal = 0 ' 排除最后一列(总计列) For j = 1 To dataRange.Columns.count - 1 If IsNumeric(dataRange.Cells(i, j).value) Then rowTotal = rowTotal + dataRange.Cells(i, j).value End If Next j values(i) = rowTotal Next i CalculateManualRowTotal = values End Function ' ===== 错误定位辅助函数 ===== Private Function GetErrorLocation(lineNum As Long) As String Select Case lineNum Case 0: GetErrorLocation = "图表对象创建" Case 1: GetErrorLocation = "透视表刷新" Case 2: GetErrorLocation = "数据范围验证" Case 3: GetErrorLocation = "添加数据系列" Case 4: GetErrorLocation = "添加总计系列" Case 5: GetErrorLocation = "图表格式设置" Case Else: GetErrorLocation = "未知位置" End Select End Function ' ===== 获取分类轴标签 ===== Private Function GetCategoryLabels(pt As pivotTable) As Variant On Error Resume Next Dim labelRange As Range ' 尝试获取行字段标签 If Not pt.RowRange Is Nothing Then Set labelRange = pt.RowRange.Offset(1).Resize(pt.RowRange.rows.count - 1) End If ' 后备方案:使用日期列 If labelRange Is Nothing Then Set labelRange = pt.DataBodyRange.Columns(1) End If Set GetCategoryLabels = labelRange End Function ' ===== 增强版获取行总计值函数 ===== Private Function GetRowTotalValues(pt As pivotTable) As Variant On Error Resume Next Dim rowTotalRange As Range Dim values() As Double Dim i As Long ' 1. 查找行总计列 Dim rowTotalCol As Long rowTotalCol = FindTotalColumn(pt, False) ' False表示查找行总计 ' 2. 如果找到总计列 If rowTotalCol > 0 Then Set rowTotalRange = pt.DataBodyRange.Resize(, 1).Offset(, rowTotalCol - 1) ' 3. 验证数据范围 If Not rowTotalRange Is Nothing And rowTotalRange.rows.count > 0 Then ReDim values(1 To rowTotalRange.rows.count) ' 4. 填充值数组 For i = 1 To rowTotalRange.rows.count If IsNumeric(rowTotalRange.Cells(i, 1).value) Then values(i) = rowTotalRange.Cells(i, 1).value Else values(i) = 0 End If Next i GetRowTotalValues = values Exit Function End If End If ' 5. 后备方案:手工计算行总计 GetRowTotalValues = CalculateManualRowTotal(pt) End Function ' ===== 增强版查找总计列函数 ===== Private Function FindTotalColumn(pt As pivotTable, ByVal findColumnTotal As Boolean) As Long On Error Resume Next Dim rng As Range Dim headerCell As Range Dim searchTerms As Variant Dim i As Long ' 设置搜索术语(多语言支持) If findColumnTotal Then searchTerms = Array("列总计", "Column Total", "Grand Total") Else searchTerms = Array("行总计", "Row Total", "Grand Total") End If ' 获取标题行范围(通常是第一行或第二行) If pt.RowRange.rows.count > 1 Then Set rng = pt.RowRange.rows(1) Else Set rng = pt.TableRange2.rows(1) End If ' 遍历标题行查找匹配项 For i = 1 To rng.Columns.count Set headerCell = rng.Cells(1, i) ' 检查是否匹配任何搜索术语 For Each term In searchTerms If InStr(1, headerCell.value, term, vbTextCompare) > 0 Then FindTotalColumn = i Exit Function End If Next term Next i ' 如果找不到,返回0 FindTotalColumn = 0 End Function ' === 手动计算行总计值 === Private Function GetManualRowTotalValues(pt As pivotTable) As Variant Dim i As Long, j As Long Dim dataRange As Range Dim values() As Double Dim columnCount As Long Set dataRange = pt.DataBodyRange If dataRange Is Nothing Then ReDim values(1 To 1) values(1) = 0 GetManualRowTotalValues = values Exit Function End If columnCount = dataRange.Columns.count ReDim values(1 To dataRange.rows.count) ' 手动计算每行的总和(排除列总计列) For i = 1 To dataRange.rows.count Dim rowTotal As Double rowTotal = 0 ' 排除最后一列(列总计) For j = 1 To columnCount - 1 If IsNumeric(dataRange.Cells(i, j).value) Then rowTotal = rowTotal + dataRange.Cells(i, j).value End If Next j values(i) = rowTotal Next i GetManualRowTotalValues = values End Function ' === 终极方法:通过XML操作强制禁用总计 === Private Sub ForceDisablePivotTotal(pt As pivotTable) On Error Resume Next Dim xmlDoc As Object Dim xmlNode As Object ' 获取透视表XML Dim xml As String xml = pt.PivotTableXML ' 创建XML文档对象 Set xmlDoc = CreateObject("MSXML2.DOMDocument") xmlDoc.async = False xmlDoc.LoadXML xml ' 查找总计设置节点 Set xmlNode = xmlDoc.SelectSingleNode("//pivotTableDefinition/showRowGrandTotals") If Not xmlNode Is Nothing Then xmlNode.Text = "0" Set xmlNode = xmlDoc.SelectSingleNode("//pivotTableDefinition/showColGrandTotals") If Not xmlNode Is Nothing Then xmlNode.Text = "0" ' 应用修改后的XML pt.PivotTableXML = xmlDoc.xml ' 刷新透视表 pt.RefreshTable End Sub ' ===== 后期绑定创建数据透视表 ===== Private Sub CreatePivotUsingLateBinding(wsDashboard As Worksheet, _ pivotRange As Range, _ dateFieldName As String, _ itemFieldName As String, _ countFieldName As String, _ typeFieldName As String, _ dataField As String, _ chartType As Integer, _ chartTitle As String, _ statusFieldName As String, _ statusType As Integer) On Error GoTo ErrorHandler Dim wb As Object, ws As Object, pc As Object, pt As Object, pf As Object Set wb = ThisWorkbook Set ws = wsDashboard ' 创建PivotCache Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pivotRange) ' 创建PivotTable Set pt = pc.CreatePivotTable(TableDestination:=ws.Range("A3"), TableName:="LateBoundPivot") ' 添加行字段(日期) Set pf = pt.PivotFields(dateFieldName) pf.orientation = 1 ' xlRowField pf.position = 1 ' 添加列字段(项目) Set pf = pt.PivotFields(itemFieldName) pf.orientation = 2 ' xlColumnField pf.position = 1 ' === 添加状态类型过滤 === If statusType = 1 Or statusType = 2 Then Set pf = pt.PivotFields(statusFieldName) pf.orientation = 3 ' xlPageField pf.position = 1 If statusType = 1 Then pf.CurrentPage = "未解决状态" ElseIf statusType = 2 Then pf.CurrentPage = "全部状态" End If End If ' 添加过滤字段(如果需要) If dataField <> "" Then Set pf = pt.PivotFields(typeFieldName) pf.orientation = 3 ' xlPageField pf.position = 1 pf.CurrentPage = dataField End If ' 添加数据字段 Set pf = pt.PivotFields(countFieldName) pf.orientation = 4 ' xlDataField pf.Function = -4157 ' xlSum pf.NumberFormat = "#,##0" pf.Name = "数量" ' 添加额外的行字段(如果需要) If chartType <> 3 Then Set pf = pt.PivotFields(typeFieldName) pf.orientation = 1 ' xlRowField pf.position = 2 End If ' 【关键修改】禁用所有总计 pt.RowGrand = False pt.ColumnGrand = False ' 禁用列总计 ' === 防止自动格式重置设置 === pt.HasAutoFormat = False ' 再次确认禁用列总计 pt.ColumnGrand = False pt.RefreshTable ' 调用增强版图表函数 CreateEnhancedLineChart wsDashboard, pt, chartTitle Exit Sub ErrorHandler: ' 后备方案:基于原始数据创建简单折线图 CreateBasicLineChart wsDashboard, pivotRange, chartTitle End Sub ' === 新的手动计算总计函数 === Private Function GetManualTotalValues(pt As pivotTable) As Variant Dim i As Long, j As Long Dim dataRange As Range Dim values() As Double Set dataRange = pt.DataBodyRange If dataRange Is Nothing Then ReDim values(1 To 1) values(1) = 0 GetManualTotalValues = values Exit Function End If ReDim values(1 To dataRange.rows.count) ' 手动计算每行的总和 For i = 1 To dataRange.rows.count Dim rowTotal As Double rowTotal = 0 For j = 1 To dataRange.Columns.count If IsNumeric(dataRange.Cells(i, j).value) Then rowTotal = rowTotal + dataRange.Cells(i, j).value End If Next j values(i) = rowTotal Next i GetManualTotalValues = values End Function ' === 辅助函数:获取总计值数组 === Private Function GetTotalValues(pt As pivotTable) As Variant Dim i As Long Dim values() As Double Dim dataRange As Range Dim totalCol As Long ' 查找总计列的位置 totalCol = 0 For i = 1 To pt.ColumnFields.count If InStr(1, pt.ColumnFields(i).Name, "总计") > 0 Or _ InStr(1, pt.ColumnFields(i).Name, "Grand Total") > 0 Then totalCol = i Exit For End If Next i ' 获取总计列数据 If totalCol > 0 Then Set dataRange = pt.DataBodyRange.Offset(0, totalCol - 1).Resize(pt.DataBodyRange.rows.count, 1) ReDim values(1 To dataRange.rows.count) For i = 1 To dataRange.rows.count values(i) = dataRange.Cells(i, 1).value Next i GetTotalValues = values Else ' 计算总计值 Dim j As Long Set dataRange = pt.DataBodyRange ReDim values(1 To dataRange.rows.count) For i = 1 To dataRange.rows.count Dim rowTotal As Double rowTotal = 0 For j = 1 To dataRange.Columns.count rowTotal = rowTotal + dataRange.Cells(i, j).value Next j values(i) = rowTotal Next i GetTotalValues = values End If End Function ' ===== 基础折线图后备方案 ===== Private Sub CreateBasicLineChart(ws As Worksheet, dataRange As Range, chartTitle As String) On Error Resume Next ' 创建图表对象 Dim chartObj As ChartObject Set chartObj = ws.ChartObjects.Add( _ Left:=100, _ Top:=100, _ Width:=600, _ Height:=400) ' 配置基础折线图 With chartObj.Chart .SetSourceData Source:=dataRange .chartType = xlLine .HasTitle = True .chartTitle.Text = chartTitle & " (基础图表)" .HasLegend = True .Legend.position = xlBottom .Axes(xlValue).HasTitle = True .Axes(xlValue).AxisTitle.Text = "数量" End With End Sub Function GetScheduleUpdateDate(wsSchedule As Worksheet) As Date Dim lastRow As Long Dim i As Long Dim cellValue As Variant Dim potentialDate As Date Dim maxDate As Date Dim found As Boolean On Error GoTo ErrorHandler lastRow = wsSchedule.Cells(wsSchedule.rows.count, "I").End(xlUp).row found = False maxDate = 0 For i = 2 To lastRow cellValue = wsSchedule.Cells(i, "I").value If cellValue <> "" Then If IsDate(cellValue) Then potentialDate = CDate(cellValue) If Year(potentialDate) > 1900 Then ' 关键修改:只比较日期部分 If DateValue(potentialDate) > maxDate Or Not found Then maxDate = DateValue(potentialDate) found = True End If End If End If End If Next i If found Then ' 关键修改:返回纯日期(无时间部分) GetScheduleUpdateDate = maxDate Else GetScheduleUpdateDate = 0 End If Exit Function ErrorHandler: GetScheduleUpdateDate = 0 End Function ' ===== 新增按钮创建函数 ===== Sub CreateRecordButton() Dim ws As Worksheet Dim btn As Button ' 确保HistoryStorage表存在 If Not WorksheetExists("HistoryStorage") Then Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)) ws.Name = "HistoryStorage" Else Set ws = ThisWorkbook.Sheets("HistoryStorage") End If ' 删除现有按钮(如果有) On Error Resume Next For Each shp In ws.Shapes If shp.Type = msoFormControl And shp.FormControlType = xlButtonControl Then shp.Delete End If Next shp On Error GoTo 0 ' 创建新按钮 Set btn = ws.buttons.Add(10, 10, 120, 30) ' 位置和大小 With btn .Caption = "记录历史" .OnAction = "RecordHistory" .Name = "RecordHistoryButton" End With ' 设置按钮位置(固定位置) ws.Range("E1").value = "按钮位置标记" btn.Top = ws.Range("E1").Top btn.Left = ws.Range("E1").Left End Sub ' ===== 修改Workbook_Open事件 ===== Private Sub Workbook_Open() ' 打开工作簿时创建按钮 CreateRecordButton End Sub ' ===== 检查工作表是否存在 ===== Private Function WorksheetExists(sheetName As String) As Boolean On Error Resume Next WorksheetExists = Not ThisWorkbook.Sheets(sheetName) Is Nothing On Error GoTo 0 End Function Function GetValidFieldName(ws As Worksheet, col As String) As String On Error Resume Next GetValidFieldName = Trim(ws.Range(col & "1").value) If GetValidFieldName = "" Or Err.Number <> 0 Then Select Case col Case "A": GetValidFieldName = "记录日期" Case "B": GetValidFieldName = "名称" Case "C": GetValidFieldName = "数量" Case "D": GetValidFieldName = "类型" Case "E": GetValidFieldName = "状态类型" End Select End If End Function
09-27
提供了基于BP(Back Propagation)神经网络结合PID(比例-积分-微分)控制策略的Simulink仿真模型。该模型旨在实现对杨艺所著论文《基于S函数的BP神经网络PID控制器及Simulink仿真》中的理论进行实践验证。在Matlab 2016b环境下开发,经过测试,确保能够正常运行,适合学习和研究神经网络在控制系统中的应用。 特点 集成BP神经网络:模型中集成了BP神经网络用于提升PID控制器的性能,使之能更好地适应复杂控制环境。 PID控制优化:利用神经网络的自学习能力,对传统的PID控制算法进行了智能调整,提高控制精度和稳定性。 S函数应用:展示了如何在Simulink中通过S函数嵌入MATLAB代码,实现BP神经网络的定制化逻辑。 兼容性说明:虽然开发于Matlab 2016b,但理论上兼容后续版本,可能会需要调整少量配置以适配不同版本的Matlab。 使用指南 环境要求:确保你的电脑上安装有Matlab 2016b或更高版本。 模型加载: 下载本仓库到本地。 在Matlab中打开.slx文件。 运行仿真: 调整模型参数前,请先熟悉各模块功能和输入输出设置。 运行整个模型,观察控制效果。 参数调整: 用户可以自由调节神经网络的层数、节点数以及PID控制器的参数,探索不同的控制性能。 学习和修改: 通过阅读模型中的注释和查阅相关文献,加深对BP神经网络与PID控制结合的理解。 如需修改S函数内的MATLAB代码,建议有一定的MATLAB编程基础。
评论
成就一亿技术人!
拼手气红包6.0元
还能输入1000个字符  | 博主筛选后可见
 
红包 添加红包
表情包 插入表情
 条评论被折叠 查看
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值