Совершенствование методов обоснования выборки в аудиторской проверке (1142757), страница 47

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 47)

Расчетный алгоритм, максимизирующий целевую функцию ошибок с помощьюфункции Nmaximize, для случая необнаружения ошибок.Clear["Global`*"] n = 56; Y = 10000000; a = 1/20; r = Reduce[p0 + p100 == 1 && p0 >= 0 && p100 >= 0 && p0^n == a, {p0, p100}, Reals, Backsubstitution ‐> True]; q = NMaximize[{(1/100)*Y*( 0*p0 + 100*p100), r}, {p0, p100}] c. Расчетный алгоритм, максимизирующий целевую функцию ошибок с помощьюуравнений Куна-Таккера, для случая 1-2 ошибки.240 Clear["Global`*"] Y = 10000000; n = 60; t = Sort[{20, 25}];(*коэффициенты искажений*) bb = 1/20;(* уровень риска выборки *) m = Length[t];(*количество коэффициентов искажения*) v[sum_] := Total[Table[If[sum >= x, 1, 0] t[[m + 1 ‐ x]], {x, m}]]; (*логическая функция для удаления строк матрицы, где сумма коэффициентов искажений по строкам матрицы превышает сумму соответствующих коэффициентов по выборочной совокупности*) h[sum_] := t # & /@ Flatten[Permutations /@IntegerPartitions[sum, {m}, Range[0, sum]], 1]; (*определение функции генерации матрицы исходов ошибок*) g[sum_]:=Select[Join[h[sum], List /@ Total[h[sum],{2}], 2], #[[m+1]] <= v[sum] &]; (*определение функции, добавляющей столбец суммы ошибок по строкам справа и удаляющей строки матрицы несоответствующим условиям*) f[sum_] := Join[List /@ Table[n ‐ sum, Length[g[sum]]], g[sum], 2] // MatrixForm; (*определение функции, добавляющей столбец слева для исходов z0*) matx = Join[Sequence @@ Table[f[x], {x, 0, m}], 2]; (*сборка матрицы*) list0 = matx[[1, All, 1 ;; 1]]; list1 = 1/t[[1]] matx[[1, All, 2 ;; 2]]; list2 = 1/t[[2]] matx[[1, All, 3 ;; 3]]; list100 = 0*matx[[1, All, 4 ;; 4]]; KTEqs[obj_, cons_List, vars_] := Module[{consconvrule = {GreaterEqual[x_, y_] ‐> LessEqual[y ‐ x, 0], Equal[x_, y_] ‐> Equal[x ‐ y, 0], LessEqual[x_, y_] ‐> LessEqual[x ‐ y, 0], LessEqual[lb_, x_, ub_] ‐> LessEqual[(x ‐ lb) (x ‐ ub), 0], GreaterEqual[ub_, x_, lb_] ‐> LessEqual[(x ‐ lb) (x ‐ ub), 0]}, stdcons, eqcons, ineqcons, lambdas, mus, lagrangian, eqs1, eqs2, eqs3, alleqns, allvars}, stdcons = cons /. consconvrule; eqcons = Cases[stdcons, Equal[_, 0]][[All, 1]]; ineqcons = Cases[stdcons, LessEqual[_, 0]][[All, 1]]; lambdas = Array[\[Lambda], Length[eqcons]]; mus = Array[\[Mu], Length[ineqcons]]; lagrangian = obj + lambdas.eqcons + mus.ineqcons; eqs1 = Thread[D[lagrangian, {vars}] == 0]; eqs2 = Thread[mus >= 0]; eqs3 = Thread[mus*ineqcons == 0]; alleqns = Join[eqs1, eqs2, eqs3, cons]; allvars = Join[vars, lambdas, mus]; {alleqns, allvars}] KTMinimize[obj_, cons_List, vars_List] := Block[{kteqs, r, rls, objvals, minobj, objrls, res}, kteqs = KTEqs[obj, cons, vars]; r = LogicalExpand@ Reduce[Sequence @@ kteqs, Backsubstitution ‐> True, Cubics ‐> True, Quartics ‐> True]; If[Head[r] === And, rls = List @@ ToRules[r]; objvals = obj /. rls; res = {objvals, rls},(*Else*)rls = List @@ (ToRules /@ r); objvals = obj /. rls; minobj = Min[objvals]; objrls = Thread[{objvals, rls}]; res = Select[objrls, #[[1]] == minobj &]; If[Length[Clear["Global`*"] res] == 1, res = res[[1]]]; ]; 241 res] d = Total[Sum[n!/(z0!*z1!*z2!*z100!)*p0^z0*p1^z1*p2^z2*p100^z100, {z0, {list0}}, {z1, {list1}}, {z2, {list2}}, {z100, {list100}}]]; AbsoluteTiming[ KTMinimize[‐(1/100)* Y*(t[[1]]*p1 + t[[2]]*p2 + 100*(1 ‐ p0 ‐ p1 ‐ p2)), { p0 >= 0, p1 >= 0, p2 >= 0, (Sequence @@ d) >= bb}, {p0, p1, p2}] // N](*нахождение верхнего предела ошибки*) d.

Автоматизированныйрасчетныйалгоритм,максимизирующийцелевуюфункцию ошибок с помощью метода «множественного случайного поиска» ипроверочной функции FindMaximum, для случая 0-10 ошибок.Clear["Global`*"] searches = 10; (*число случайных поисков [при большом количестве искажений возможно потребуется увеличить это значение до 20,50,100]*) Y = 10000000;(*монетарный объем генеральной совокупности*) n = 60;(*объем выборки*) t = Sort[{10, 15, 16, 20, 30, 40}];(*коэффициенты искажений*) bb = 1/20;(*уровень риска выборки *) m = Length[t];(*количество коэффициентов искажений*) v[sum_] := Total[Table[If[sum >= x, 1, 0] t[[m + 1 ‐ x]], {x, m}]]; (*логическая функция для удаления строк матрицы, где сумма коэффициентов искажений по строкам матрицы превышает сумму соответствующих коэффициентов по выборочной совокупности*) h[sum_] := t # & /@Flatten[Permutations /@IntegerPartitions[sum, {m}, Range[0, sum]], 1]; (*определение функции генерации исходов ошибок*) g[sum_]:=Select[Join[h[sum], List /@ Total[h[sum],{2}], 2], #[[m+1]] <= v[sum] &]; (*определение функции, добавляющей столбец суммы ошибок по строкам справа и удаляющей строки матрицы несоответствующим условиям*) f[sum_] := Join[List /@ Table[n ‐ sum, Length[g[sum]]], g[sum], 2] // MatrixForm; (*определение функции, добавляющей столбец слева для исходов z0*) Needs["IPOPTLink`"]; ipconsrl = { ( a_ == b_ ) ‐> LessEqual[0, a ‐ b, 0], ( a_ <= b_ ) ‐> LessEqual[‐\[Infinity], a ‐ b, 0], (a_ >= b_ ) ‐> LessEqual[0, a ‐ b, \[Infinity]] }; iminsetup[cons_List, vlus_List] := Block[{vars, lbubs, cfuns, clbubs, lb, ub}, {vars, lbubs} = Transpose[ vlus /. {v_, lb_?NumericQ, ub_?NumericQ} :> {v, {lb, ub}}]; {cfuns, clbubs} = Transpose[ cons /. ipconsrl /. LessEqual[lb_, v_, ub_] ‐> {v, {lb, ub}} ]; {vars, lbubs, cfuns, clbubs} ]; statusrl = {0 ‐> "Solve_Succeeded", 1 ‐> "Solved_To_Acceptable_Level", 2 ‐> "Infeasible_Problem_Detected", 3 ‐> "Search_Direction_Becomes_Too_Small", 4 ‐> "Diverging_Iterates", 5 ‐> "User_Requested_Stop", 6 ‐> "Feasible_Point_Found", ‐1 ‐> "Maximum_Iterations_Exceeded", ‐2 ‐> "Restoration_Failed", ‐3 ‐> "Error_In_Step_Computation", ‐4 ‐> "Maximum_CpuTime_Exceeded", ‐10 ‐> 242 "Not_Enough_Degrees_Of_Freedom", ‐11 ‐> "Invalid_Problem_Definition", ‐12 ‐> "Invalid_Option", ‐13 ‐> "Invalid_Number_Detected", ‐100 ‐> "Unrecoverable_Exception", ‐101 ‐> "NonIpopt_Exception_Thrown", ‐102 ‐> "Insufficient_Memory", ‐199 ‐> "Internal_Error"}; createParam[obj_, cons_List, vlus_List, opts___] := Block[{vars, lbubs, cfuns, clbubs, params, param}, {vars, lbubs, cfuns, clbubs} = iminsetup[cons, vlus]; params = Table[param[i], {i, Length[vlus]}]; {ParametricIPOPTMinimize[obj, vars, params, lbubs, cfuns, clbubs, params, "RuntimeOptions" ‐> {"WarningMessages" ‐> False}, "IPOPTOptions" ‐> {"max_iter" ‐> 10^5, "tol" ‐> 10^‐10}, opts], lbubs} ]; iMin[param_, starts_List] := Block[{pres, status, listres, goodres, ord, bestres}, pres = param @@@ starts; listres = {IPOPTMinValue[#], IPOPTArgMin[#], IPOPTReturnCode[#]} & /@ pres; IPOPTDataDelete /@ pres; status = listres[[All, 3]]; Print[Tally[status] /. {s_, n_Integer} :> { s /. statusrl, n}]; goodres = Select[listres, #[[3]] == 0 &]; ord = Ordering[goodres[[All, 1]]]; goodres[[First @ ord]] ]; iMin[obj_, cons_List, vwb_List, starts_List] := iMin[ createParam[obj, cons, vwb][[1]], starts]; genRands[lbubs_List, nrands_Integer, seed_Integer] := Block[{}, SeedRandom[seed]; Transpose[RandomReal[#, nrands] & /@ lbubs]]; iMin[paramlbs_, nrands_Integer, seed_Integer] := iMin[paramlbs[[1]], genRands[paramlbs[[2]], nrands, seed]]; iMin[obj_, cons_List, vwb_List, nrands_Integer, seed_Integer] := Block[{paramlbs = createParam[obj, cons, vwb], res}, res = iMin[paramlbs, nrands, seed]; {res[[1]], Thread[vwb[[All, 1]] ‐> res[[2]]]} ]; (*алгоритм множественного случайного поиска*) matx = Join[Sequence @@ Table[f[x], {x, 0, m}], 2]; (*сборка матрицы исходов ошибок*) list0 = matx[[1, All, 1 ;; 1]]; list199 = Table[1/t[[x]] matx[[1, All, x + 1 ;; x + 1]], {x, m}]; list100 = 0*matx[[1, All, m + 2 ;; m + 2]]; (*разбиение преобразованной матрицы на столбцы и деление ее элементов на соответствующие коэффициенты искажений, для получения исходов ошибок с их последующей подстановкой в функцию вероятности полиномиального распределения (ограничение максимизации целевой функции)*) d = Total[Sum[n!/Subscript[z, 100]!*Subscript[p, 100]^Subscript[z, 100]* Product[Subscript[p, x]^Subscript[z, x]/Subscript[z, x]!, {x, 0, m}], {Subscript[z, 0], {list0}}, Evaluate[Sequence @@ Table[{Subscript[z, x], {list199[[x]]}}, {x, m}]], {Subscript[z, 100], {list100}}]]; (*генерация главного ограничения целевой функции по матрице исходов ошибок*) r = Reduce[Sequence @@ Table[Subscript[p, x] >= 0, {x, 0, m}] && Subscript[p, 100] >= 0, Append[Table[Subscript[p, x], {x, 0, m}], Subscript[p, 100]]]; (*ограничения целевой функции*) 243 q = AbsoluteTiming[iMin[‐Y/100*(Total[Table[t[[x]] Subscript[p, x], {x, m}]] + 100*Subscript[p, 100]), List @@ (Total[Table[Subscript[p, x], {x, 0, m}]] + Subscript[p, 100] == 1 && r && (Sequence @@ d) == bb), Thread[{Append[Table[Subscript[p, x], {x, 0, m}], Subscript[p, 100]], 0, 1}], searches, 0] // N] (*изменяя знак целевой функции на противоположенный, мы находим ее максимум путем минимизации, а также подсчитываем время вычисления в секундах, затраченное на вычисление максимума целевой функции ошибок*) s = Append[Table[Subscript[p, x] /. Last[q[[2]]], {x, 0, m}] , Subscript[p, 100] /. Last[q[[2]]]]; (*получение значений вероятностей*) FindMaximum[{Y/100*(Total[Table[t[[x]] Subscript[p, x], {x, m}]] + 100*Subscript[p, 100]), Total[Table[Subscript[p, x], {x, 0, m}]] + Subscript[p, 100] == 1 && r && (Sequence @@ d) == bb}, Thread[{Append[Table[Subscript[p, x], {x, 0, m}], Subscript[p, 100]], s}]] (*проверка максимизации с помощью функции FindMaximum*) Dimensions[matx[[1]]] (*подсчет строк матрицы*) 4.

Характеристики

Список файлов диссертации