読者です 読者をやめる 読者になる 読者になる

end0tknr's kipple - 新web写経開発

http://d.hatena.ne.jp/end0tknr/ から移転します

回帰分析における寄与率(=決定係数)と、残差や相関係数との関係

先程のエントリにも記載していますが、 「寄与率」は回帰分析にもあり、それを混同していたので、再整理。

f:id:end0tknr:20170521193847g:plain

寄与率(=決定係数) の定義式


総平方和: S_T = \sum_{i=1}^{n} (y_{i} -  \overline{y} )^{2}

ここで、  y_{i} は実測値で、  \overline{y} は実測値の総平均。


残差平方和: S_E = \sum_{i=1}^{n} (y_{i} -  \hat{y_{i}} )^{2}

ここで、  \hat{y} はモデル値(予測値)。

これらを用いて、寄与率(=決定係数)は次のように定義されています。


寄与率(決定係数): R^{2} = \frac{ S_T - S_E }{ S_T }

また、上記の「回帰による平方和」を利用し、次のように表すことが可能です。


回帰による平方和: S_R = \sum_{i=1}^{n} (\hat{y_{i}} - y_{i})^{2}

寄与率(決定係数):
R^{2} = \frac{ S_R }{ S_T } =  \frac{ S_T - S_E }{ S_T } = 1 - \frac{S_E}{S_T}

寄与率(=決定係数) は、なぜ Rの2乗で表すか?

相関係数であるRと、寄与率(=決定係数)の間に2乗の関係があることが理由のようです。

更に…自由度修正済み寄与率

先程、記載した寄与率は説明変数が増える程、上昇するらしい。 (実際の説明力の有無に関らず、寄与率が増加…)

そこで「自由度」を考慮し修正した「自由度修正済み寄与率」があるらしい。(以下)


自由度修正済み寄与率( R^{2} ) :
R^{2} = 1 - \frac{ \frac{残差の平方和}{残差の自由度} }
                 { \frac{総平方和}{ n - 1} }

ただし、 n=データ数、残差の自由度 = データ数(n) - 説明変数の数 - 1

寄与度/寄与率 : データ全体(合計)の"変化"に対する各構成要素の貢献度

寄与度の定義

「全体の"変化"に対する」がポイントで、 年度の総売上額に対する部門Aの寄与度/寄与率は次式で算出できます。


  部門Aのt年の寄与度 =
  \frac{ 部門Aのt年売上 - 部門Aの(t-1)年売上 }{ (t-1)年総売上額 } \\\
 または 
  { 部門Aのt年成長率 \cdot 部門Aの(t-1)年構成比率 }

  部門Aのt年の寄与率 = \frac{ 部門Aのt年寄与度 }{ 総額のt年成長率 }

例題

例として、年度の総売上額に対する部門A~Cの寄与度/寄与率を算出します。

年度 部門A 部門B 部門C 総額
2011 500 300 200 1000
2012 600 300 400 1300
2013 800 500 300 1600
2014 1000 600 400 2000

年度毎の変化

まず、上記の表から年度毎の変化を整理します

年度<-前年 部門A 部門B 部門C 総額
2012<-2011 100 0 200 300
2013<-2012 200 200 -100 300
2014<-2013 200 100 100 400

寄与度

次に寄与度を算出しますが、 例えば、部門Aの2012年寄与度は「(600-500)/1000 = 0.1」です。 他部門や他年度も同様に寄与度を計算すると次のようになります。

年度<-前年 部門A 部門B 部門C
2012<-2011 0.10 0.0 0.20
2013<-2012 0.15 0.15 -0.08
2014<-2013 0.13 0.06 0.06

寄与率

まず、総額成長率( (t年売上 - (t-1)年売上) / (t-1)年売上 )を算出します。

年度<-前年 総額成長率
2012<-2011 0.30
2013<-2012 0.23
2014<-2013 0.25

寄与率は「部門の寄与度」と「総額の成長率」により算出され、 例えば部門Aの2012年寄与率は、0.1x0.3=0.03となります。 他部門や他年度も同様に寄与率を計算すると次のようになります。

年度<-前年 部門A 部門B 部門C
2012<-2011 0.03 0.0 0.06
2013<-2012 0.03 0.03 -0.02
2014<-2013 0.03 0.02 0.02

固有値、固有ベクトル

主成分分析に利用する為、おさらい。

その他、シュレーディンガー方程式(量子力学)、マルコフ連鎖グラフ理論 でも利用されるらしいが、今回は単なるおさらし。

定義

n次正方行列Aに対し、   A \textbf{x} = \lambda  \textbf{x} が成立するとき、定数:λを「固有値」、 ベクトル  \textbf{x} を「固有ベクトル

固有値固有ベクトル の算出例


 \left(
    \begin{array}{cc}
      8 , 1 \\
      4 , 5
    \end{array}
  \right)
固有値固有ベクトルを算出する。

まず、  \left| A - \lambda E \right| = 0 行列式を解き、固有値を求める。


  \left|
    \begin{array}{cc}
      {8 - \lambda} & {1} \\\ 
      {4} & {5 - \lambda}
    \end{array}
  \right| = 0
 (8 - \lambda)(5 - \lambda) - 4 = 0
 \lambda^{2} - 13 \lambda + 36 = 0
 \underline{ \lambda = 4 , 9 }

次に λ = 4 , 9 に対応するそれぞれの固有ベクトルを求める。

まずは「λ = 4」の場合


  \left(
    \begin{array}{cc}
      {8 - 4} & {1} \\\ 
      {4} & {5 - 4}
    \end{array}
  \right)
  \left(
    \begin{array}{c}
      x_1 \\\ 
      x_2
    \end{array}
  \right)
= 0

  \left(
    \begin{array}{cc}
      {4} & {1} \\\ 
      {4} & {1}
    \end{array}
  \right)
  \left(
    \begin{array}{c}
      x_1 \\\ 
      x_2
    \end{array}
  \right)
= 0
 4 x_{1} + x_{2} = 0

よって、「λ = 4」に対応する固有ベクトル 
  t
  \left(
    \begin{array}{c}
      {1} \\
      {-4}
    \end{array}
  \right)
 ※ただし、tは0以外の任意数。

次に「λ = 9」の場合


  \left(
    \begin{array}{cc}
      {8 - 9} & {1} \\\ 
      {4} & {5 - 9}
    \end{array}
  \right)
  \left(
    \begin{array}{c}
      x_1 \\\ 
      x_2
    \end{array}
  \right)
= 0

  \left(
    \begin{array}{cc}
      {-1} & {1} \\\ 
      {4} & {-4}
    \end{array}
  \right)
  \left(
    \begin{array}{c}
      x_1 \\\ 
      x_2
    \end{array}
  \right)
= 0

\begin{cases}
- x_{1} + x_{2} = 0 \\\
4 x_{1} -4 x_{2} = 0
\end{cases}

よって、「λ = 9」に対応する固有ベクトル 
  t
  \left(
    \begin{array}{c}
      {1} \\
      {1}
    \end{array}
  \right)
 ※ただし、tは0以外の任意数。

正弦定理の証明

正弦定理は、なんとか…記憶にありましたが、余弦定理のついでに

正弦定理とは?

f:id:end0tknr:20170514175841p:plain


 \frac {a}{sin A} =  \frac {b}{sin B} =  \frac {c}{sin C} = 2R
 ただし、Rは外接円の半径。

正弦定理の証明

先程の余弦定理と同様、∠Aが鋭角,直角,鈍角に分け、導出します

(正弦)鋭角

f:id:end0tknr:20170514180317p:plain

まず、点Bと円の中心を通るBDを描くと、 BDは円の中心を通る為、△BCDは直角三角形 となります。

また、a を共有する為、∠A = ∠D でもあります。

ここで、sin BDC を求めると、 
 sin BDC = \frac{BC}{BD} = \frac{a}{2R}
となり、最終的に正弦定理を導出できます。


 sin A = \frac{a}{2R} \rightarrow \underline{2R = \frac{a}{sin A}}

(正弦)直角

f:id:end0tknr:20170514191350p:plain

上図の通り、a = 2R で、また、sin A = sin 90 = 1 の為、以下が成り立つ。

 \underline{2R = \frac{a}{sin A}}

(正弦)鈍角

f:id:end0tknr:20170514191700p:plain

上図のように、円の中心を通るBDを描くと、 □ABCDは外周円を持つ為、∠A + ∠D = 180度

ここで、sin Dを求めると、以下のように正弦定理を導出できます。

 sin D = \frac{BC}{BD} = \frac{a}{2R}
 sin (180 - A) = \frac{a}{2R}
 \underline{ sin A = \frac{a}{2R} }

余弦定理の証明

こうも忘れていると「そもそも当時、理解してたの?」と思いますが、 余弦定理と正弦定理もすっかり忘れていたので、以下、自分用メモ。 まずは、余弦定理から

余弦定理とは?

f:id:end0tknr:20170514170556p:plain

 \displaystyle a^{2} = b^{2} + c^{2} - 2bc \cdot cos A
 \displaystyle b^{2} = a^{2} + c^{2} - 2ac \cdot cos B
 \displaystyle c^{2} = a^{2} + b^{2} - 2ab \cdot cos C

余弦定理の証明

∠Aが鋭角,直角,鈍角に分け、導出します

(余弦)鋭角

f:id:end0tknr:20170514171207p:plain

上記のように補助線CHを描くと、CH, BHは次のように表せる。

 CH = b \cdot sin A  ,  BH = c - b \cdot cos A …(1)

また、△BCHは直角三角形である為、ピタゴラスの定理(三平方の定理)から  BC^{2} = CH^{2} + BH^{2} …(2)が成立する。

式(2)へ式(1)を代入し変形すると、余弦定理の式が導出できる。

 BC^{2} = (b \cdot sin A)^{2} + (c - b \cdot cos A)^{2}
 a^{2} = (b^{2} \cdot sin^{2} A) +
   (c^{2} - 2 bc \cdot cos A + b^{2} \cdot cos^{2} A)
 a^{2} = b^{2} (sin^{2} A + cos^{2} A) + c^{2} - 2 bc \cdot cos A
 \underline{ a^{2} = b^{2} + c^{2} - 2 bc \cdot cos A }

(余弦)直角

f:id:end0tknr:20170514173423p:plain

また、△ABCは直角三角形である為、先程と同様、 ピタゴラスの定理(三平方の定理)を用います。

 a^{2} = b^{2} + c^{2}

また、∠A=90度 のとき、cos A=0 となる為、次の式が成立します。

 \underline{ a^{2} = b^{2} + c^{2} - 2 bc \cdot cos A }

(余弦)鈍角

f:id:end0tknr:20170514173853p:plain

まず、直角三角形 BCHに対し、ピタゴラスの定理(三平方の定理)を用います。

 BC^{2} = BH^{2} + CH^{2} …(1)

また、

 sin (180-A) = \frac{CH}{b} \rightarrow CH = b \cdot sin (180 - A)
      \rightarrow CH = b \cdot sin A …(2)
 BH = BA + AH = c + (b \cdot cos(180 - A)) = c - b \cdot cos A …(3)

最後に式(2)(3)を式(1)へ代入し、変形すると、余弦定理の式が導出できます。

 a^{2} =  ( b \cdot sin A )^{2} + ( c - b \cdot cos A )^{2}
 a^{2} =  ( b^{2} \cdot sin^{2} A ) +
( c^{2} - 2bc \cdot cos A + b^{2} \cdot cos^{2} A )
 a^{2} =  b^{2} (sin^{2} A + cos^{2} A ) +
c^{2} - 2bc \cdot cos A
 \underline{
a^{2} =  b^{2} + c^{2} - 2bc \cdot cos A
}

ベクトルの内積、内積の成分表示、シュミットの正規直交化法

シュミットの正規直交化法をすっかり忘れていたので、基本からのメモ

内積の定義

 \displaystyle
\textbf{a} \cdot \textbf{b} =
\|a\| \cdot \|b\| \cdot cos \theta

 \displaystyle
||a||
 \displaystyle
||b||
は、ベクトルの大きさ(ノルム)

内積の成分表示

2次元ベクトル

 \displaystyle
\textbf{a} = 
\begin{pmatrix}
  x_{1} \\\
  y_{1}
\end{pmatrix}
,
\textbf{b} = 
\begin{pmatrix}
  x_{2} \\\
  y_{2}
\end{pmatrix}

\rightarrow

\textbf{a} \cdot \textbf{b} = x_{1}x_{2} + y_{1}y_{2}

3次元ベクトル

 \displaystyle
\textbf{a} = 
\begin{pmatrix}
  x_{1} \\\
  y_{1} \\\
  z_{1}
\end{pmatrix}
,
\textbf{b} = 
\begin{pmatrix}
  x_{2} \\\
  y_{2} \\\
  z_{2}
\end{pmatrix}

\rightarrow

\textbf{a} \cdot \textbf{b} = x_{1}x_{2} + y_{1}y_{2} + z_{1}z_{2}

内積の成分表示の証明(2次元ベクトルにおける導出)

f:id:end0tknr:20170514085717p:plain bの反対ベクトル(-b)とで形成される△ADEで 三平方の定理(ピタゴラスの定理)を考える。

 \displaystyle{ AE^2 = AD^2 + DE^2 }
 \displaystyle{
\|a - b\|^2 = ( \|a\| + \|b\| cos\theta  )^2 + ( \|b\| sin\theta  )^2
}
 \displaystyle{
\|a - b\|^2 =
  (\|a\|^2 + 2\|a\|\|b\|cos\theta + (\|b\|cos\theta)^2) + (\|b\|sin\theta)^2
  …(1)
}
 \displaystyle{
\|a - b\|^2 =
  \|a\|^2 + 2\textbf{a} \cdot \textbf{b} + \|b\|^2
  …(2)
}

※式(1)→(2)の変形では、前述の内積の定義式や  sin^{2} \theta + cos^{2}\theta = 1 を利用してます。

更に  \displaystyle{
|a - b| =
\begin{pmatrix}
  x_1 - x_2 \\
  y_1 - y_2
\end{pmatrix}
} も利用し、式(2)を更に変形し、完成。

 \displaystyle{
(x_1 - x_2)^2 + (y_1 - y_2 )^2 =
  (x_{1}^2 + y_{1}^2) + 2\textbf{a} \cdot \textbf{b} + (x_{2}^2 + y_{2}^2)
}
 \displaystyle{
(x_{1}^2 - 2{x_1}{x_2} + x_{2}^2) + (y_{1}^2 - 2{y_1}{y_2} + y_{2}^2)=
  (x_{1}^2 + y_{1}^2) + 2\textbf{a} \cdot \textbf{b} + (x_{2}^2 + y_{2}^2)
}
 \displaystyle{
- 2{x_1}{x_2} - 2{y_1}{y_2} = 2\textbf{a} \cdot \textbf{b}
}
 \displaystyle{
\underline{
  \textbf{a} \cdot \textbf{b} = {x_1}{x_2} + {y_1}{y_2}
}
}

シュミットの正規直交化法

今回は、シュミットの正規直交化法へつながる 「ベクトルa, bが与えられたときのaと垂直なベクトル」である

 \displaystyle{
\underline{
  \textbf{b} - \frac{ \textbf{a} \cdot \textbf{b}}{ \|a\|^2 } \textbf{a}
}  
}

を導出します。

f:id:end0tknr:20170514101355p:plain

上図より、aと垂直なベクトル(  \displaystyle{ \overrightarrow{BD} } )は、次のように表せる。

 \displaystyle{
\textbf{b} - \frac{\|b\| cos\theta}{\|a\|} \textbf{a} …(1) =
\textbf{b} - \frac{ \|a\|\|b\| cos\theta}{\|a\|^2} \textbf{a} …(2) =
\underline{
  \textbf{b} - \frac{ \textbf{a} \cdot \textbf{b} }{\|a\|^2} \textbf{a} …(3)
}
}

※(1)->(2)の変形では、2項の分母分子のそれぞれにベクトルaのノルムを掛け、 (2)->(3)の変形では、内積の定義式を利用しています

正規分布におけるσ(標準偏差) ~ 3σ

占有率の具体的な値を忘れていたので、メモ

範囲 占有率 備考
-1σ ~ +1σ  68.3% 標準偏差
-2σ ~ +2σ  95.4%
-3σ ~ +3σ  99.7%

f:id:end0tknr:20170511050800p:plain

excelのvbaで、HashMap(連想配列)や可変長配列、数値形式確認、日付形式確認、正規表現、値渡し

久しぶりにexcel vbaのマクロを書いたら、いろいろ忘れてたので、メモ。

ポイントはsrcと、src内のコメントの通り

'変数宣言を必須にするおまじない
Option Explicit

Dim inputSheetDev As Worksheet '開発系テーマの入力シート
Dim inputSheetOpt As Worksheet '運用系テーマの入力シート
Dim startDateIni As Date ' 集計開始日
Dim endDateIni As Date   ' 集計最終日
Dim uriDateIni As Date   ' 売上実績基準
Dim dataBarMax As Long    'データバーの最大値
Dim dataBarMaxSum As Long 'データバーの最大値(合計用)


Sub CalcJuchuuUriageSummary()
    If InitGlobalVals("はじめに") = False Then
        MsgBox "設定内容誤りの可能性で、処理開始できません"
        Exit Sub
    End If

    '#### シートの追加と、印刷設定(用紙サイズやマージン)
    Dim newSheet As Worksheet
    Set newSheet = Worksheets.Add
    Dim tmpCo As Variant
    tmpCo = setSheetFormat(newSheet)
    
   
    Dim rowCo As Integer
    Dim colCoL As Integer
    Dim colCoR As Integer
    Dim tmpCoL As Variant
    Dim tmpCoR As Variant
    Dim summary As Object
    
    '#### 開発・委託系テーマのworksheetの読み取り(parse)
    Dim inputRows As Collection
    Set inputRows = ParseInputSheet(inputSheetDev)
    'チームリーダ名を抽出
    Dim tmLeaders() As Variant
    tmLeaders = extractTmleaders(inputRows)
       
    '受注計画
    Set summary = CalcJuchuuPlans(inputRows, startDateIni, endDateIni)
    '集計結果の出力
    rowCo = 2
    colCoL = 1
    newSheet.Cells(rowCo, colCoL).Value = "■" & inputSheetDev.name & " <受注 計画>"
    tmpCoL = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoL)
    
    '受注実績
    Set summary = CalcJuchuuDones(inputRows, startDateIni, endDateIni)
    '集計結果の出力
    colCoR = tmpCoL(2) + 3
    newSheet.Cells(rowCo, colCoR).Value = "■" & inputSheetDev.name & " <受注 実績>"
    tmpCoR = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoR)
    '計画実績の差異を出力
    tmpCo = writeTblDiff(newSheet, rowCo + 1, tmpCoL(1), tmpCoL(2), tmpCoR(2))

    '売上計画
    Set summary = CalcUriagePlans(inputRows, startDateIni, endDateIni)
     '集計結果の出力
    rowCo = tmpCoL(1) + 4
    newSheet.Cells(rowCo, colCoL).Value = "■" & inputSheetDev.name & " <売上 計画>"
    tmpCoL = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoL)
    
    '売上実績
    Set summary = CalcUriageDones(inputRows, startDateIni, uriDateIni)
    '集計結果の出力
    newSheet.Cells(rowCo, colCoR).Value = "■" & inputSheetDev.name & " <売上 実績>"
    tmpCoR = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoR)
    '計画実績の差異を出力
    tmpCo = writeTblDiff(newSheet, rowCo + 1, tmpCoL(1), tmpCoL(2), tmpCoR(2))


    '#### 専任・運用系テーマのworksheetの読み取り(parse)
    Set inputRows = ParseInputSheet(inputSheetOpt)

    '売上計画
    Set summary = CalcUriagePlans(inputRows, startDateIni, endDateIni)
    '集計結果の出力
    rowCo = tmpCoL(1) + 4
    newSheet.Cells(rowCo, colCoL).Value = "■" & inputSheetOpt.name & " <売上 計画>"
    tmpCoL = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoL)
    
    '売上実績
    Set summary = CalcUriageDones(inputRows, startDateIni, uriDateIni)
    '集計結果の出力
    newSheet.Cells(rowCo, colCoR).Value = "■" & inputSheetOpt.name & " <売上 実績>"
    tmpCoR = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoR)
    '計画実績の差異を出力
    tmpCo = writeTblDiff(newSheet, rowCo + 1, tmpCoL(1), tmpCoL(2), tmpCoR(2))

End Sub

Function InitGlobalVals(ByVal setupSheetName As String) As Boolean
    InitGlobalVals = False

    If ExistWorksheet(setupSheetName) = False Then
        MsgBox "設定用シート:" & setupSheetName & " がありません"
        Exit Function
    End If
    
    Dim setupSheet As Worksheet
    Set setupSheet = Worksheets(setupSheetName)
    
    Dim sheetName As String
    sheetName = setupSheet.Cells(4, 2).Value
    If ExistWorksheet(sheetName) = False Then
        MsgBox "開発・委託系用シート:" & sheetName & " がありません"
        Exit Function
    End If
    Set inputSheetDev = Worksheets(sheetName)
    
    sheetName = setupSheet.Cells(5, 2).Value
    If ExistWorksheet(sheetName) = False Then
        MsgBox "専任・運用系用シート:" & sheetName & " がありません"
        Exit Function
    End If
    Set inputSheetOpt = Worksheets(sheetName)
    
    
    Dim dateStr As String
    dateStr = setupSheet.Cells(6, 2).Value
    If IsDate(dateStr) = False Then
        MsgBox "日付:" & dateStr & " が不正です"
        Exit Function
    End If
    startDateIni = dateStr
    
    dateStr = setupSheet.Cells(7, 2).Value
    If IsDate(dateStr) = False Then
        MsgBox "日付:" & dateStr & " が不正です"
        Exit Function
    End If
    endDateIni = dateStr
    
    dateStr = setupSheet.Cells(8, 2).Value
    If IsDate(dateStr) = False Then
        MsgBox "日付:" & dateStr & " が不正です"
        Exit Function
    End If
    uriDateIni = dateStr

    dataBarMax = 50000
    dataBarMaxSum = 100000

    InitGlobalVals = True
End Function


' 売上実績の集計
Function CalcUriageDones(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")
        
    Dim i As Integer
    
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        Dim tmpDate As Date
        tmpDate = startDate
        
        Do While tmpDate <= endDate
            Dim dateStr As String
            dateStr = tmpDate
            
            If inputRow("確度") = "売" And inputRow.Exists(dateStr) Then
                Dim tmLeader As String
                tmLeader = convTantou2Leader(inputRow("SK"))
                Dim yyyymm As String
                yyyymm = ConvDate2Str(tmpDate)
                Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow(dateStr))
            End If
        
            tmpDate = DateAdd("m", 1, tmpDate)
        Loop
    Next
    
    Set CalcUriageDones = summary
End Function

Function writeTbl(ByVal newSheet As Worksheet, ByVal summary As Object, _
                  ByVal tmLeaders As Variant, _
                  ByVal startDate As Date, ByVal endDate As Date, _
                  ByVal rowCo As Integer, ByVal colCo As Integer) As Integer()
    Dim rowCoTmp As Integer
    Dim colCoTmp As Integer
    '最左列の見出し
    rowCoTmp = writeTblLcaption(newSheet, startDate, endDate, rowCo, colCo)
    
    'チーム別の成績
    Dim i As Integer
    colCoTmp = colCo
    For i = 0 To UBound(tmLeaders)
        colCoTmp = colCoTmp + 1
        rowCoTmp = writeTblBody(newSheet, summary, tmLeaders(i), startDate, endDate, rowCo, colCoTmp)
    Next
    '最左列に合計
    rowCoTmp = writeTblSum(newSheet, rowCo, rowCoTmp, colCo + 1, colCoTmp)

    Dim coTmp(2) As Integer
    
     coTmp(1) = rowCoTmp
     coTmp(2) = colCoTmp + 1
     writeTbl = coTmp
End Function

Function CalcUriagePlans(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        Dim tmpDate As Date
        tmpDate = startDate
        
        Do While tmpDate < endDate
            Dim dateStr As String
            dateStr = tmpDate
            
            If inputRow.Exists(dateStr) Then
                Dim tmLeader As String
                tmLeader = convTantou2Leader(inputRow("SK"))
                Dim yyyymm As String
                yyyymm = ConvDate2Str(tmpDate)
                If IsNumeric(inputRow(dateStr)) Then ' 数値であることの確認
                    Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow(dateStr))
                End If
            End If
        
            tmpDate = DateAdd("m", 1, tmpDate)
        Loop
    Next
    
    Set CalcUriagePlans = summary
End Function


Function writeTblDiff(ByVal newSheet As Worksheet, _
                       ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                       ByVal colCo1 As Integer, ByVal colCo2 As Integer) As Integer
    newSheet.Cells(rowCo1, colCo2 + 1).Value = "差"
    
    Dim rowCoTmp As Integer
    For rowCoTmp = rowCo1 + 1 To rowCo2
        newSheet.Cells(rowCoTmp, colCo2 + 1).Value = _
        "=" & Cells(rowCoTmp, colCo2).Address & "-" & Cells(rowCoTmp, colCo1).Address
    Next
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo1, rowCo2, colCo2 + 1)
    '数値の表示形式設定
    newSheet.Range(Cells(rowCo1, colCo2 + 1), Cells(rowCo2, colCo2 + 1)).NumberFormatLocal _
    = "#,##0_ ;[赤]-#,##0 "
    
    writeTblDiff = rowCo2
End Function


Function writeTblSum(ByVal newSheet As Worksheet, _
                     ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                     ByVal colCo1 As Integer, ByVal colCo2 As Integer) As Integer
    
    newSheet.Cells(rowCo1, colCo2 + 1).Value = "計(千円)"
    
    Dim rowCoTmp As Integer
    For rowCoTmp = rowCo1 + 1 To rowCo2
        newSheet.Cells(rowCoTmp, colCo2 + 1).Value = _
        "=SUM(" & Cells(rowCoTmp, colCo1).Address & ":" & Cells(rowCoTmp, colCo2).Address & ")"
    Next
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo1, rowCo2, colCo2 + 1)
    '条件付き書式(データバー)設定
    rowCoTmp = setTblColDatabar(newSheet, rowCo1 + 1, rowCo2 - 1, colCo2 + 1, _
                                dataBarMaxSum, xlThemeColorAccent6)
    
    writeTblSum = rowCo2
End Function


Function writeTblBody(ByVal newSheet As Worksheet, ByVal summary As Object, _
                      ByVal tmLeader As String, _
                      ByVal startDate As Date, ByVal endDate As Date, _
                      ByVal rowCo As Integer, ByVal colCo As Integer) As Integer
    newSheet.Cells(rowCo, colCo) = tmLeader
    
    Dim tmpDateStr As String
    Dim rowCoTmp As Integer
    rowCoTmp = rowCo
    Dim price As Long  ' vbaのintegerは扱える最大値が小さい様、オーバーフローする為
    
    Do While startDate < endDate
        tmpDateStr = ConvDate2Str(startDate) ' YYYYMMの文字列に変更
        'hash mapにおけるkeyの存在確認
        If summary.Exists(tmLeader & " " & tmpDateStr) Then
            price = summary(tmLeader & " " & tmpDateStr)
        Else
            price = 0
        End If
        
        rowCoTmp = rowCoTmp + 1
        newSheet.Cells(rowCoTmp, colCo) = price
        
        startDate = DateAdd("m", 1, startDate) '1ヶ月後の日付計算
    Loop
    '合計行
    rowCoTmp = rowCoTmp + 1
    newSheet.Cells(rowCoTmp, colCo) = _
        "=SUM(" & Cells(rowCo + 1, colCo).Address & ":" & Cells(rowCoTmp - 1, colCo).Address & ")"
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo, rowCoTmp, colCo)
    '数値の表示形式設定
    newSheet.Range(Cells(rowCo + 1, colCo), Cells(rowCoTmp, colCo)).NumberFormatLocal = "#,##0_ "
    '条件付き書式(データバー)設定
    rowCoTmp = setTblColDatabar(newSheet, rowCo + 1, rowCoTmp - 1, colCo, dataBarMax, xlThemeColorAccent5)
    
    writeTblBody = rowCoTmp + 1
End Function

Function writeTblLcaption(ByVal newSheet As Worksheet, _
                          ByVal startDate As Date, ByVal endDate As Date, _
                          ByVal rowCo As Integer, ByVal colCo As Integer) As Integer
    newSheet.Cells(rowCo, colCo).Value = "年月"
    
    Dim rowCoTmp As Integer
    rowCoTmp = rowCo
    
    Do While startDate < endDate
        rowCoTmp = rowCoTmp + 1
        newSheet.Cells(rowCoTmp, colCo).Value = ConvDate2Str(startDate)
        startDate = DateAdd("m", 1, startDate)  '1ヶ月後の日付算出
    Loop
    
    rowCoTmp = rowCoTmp + 1
    newSheet.Cells(rowCoTmp, colCo).Value = "計(千円)"
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo, rowCoTmp, colCo)
    
    writeTblLcaption = rowCoTmp
End Function

Function extractTmleaders(ByVal inputRows As Collection) As Variant
    Dim tmLeadersHash As Object
    Set tmLeadersHash = CreateObject("Scripting.Dictionary")

    Dim i As Integer
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        Dim tmLeader As String
        tmLeadersHash(convTantou2Leader(inputRow("SK"))) = 1
    Next
    
    extractTmleaders = tmLeadersHash.Keys
End Function

Function CalcJuchuuPlans(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary") ' vbaのhash map
    
    Dim i As Integer
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        
        Dim inDateStr As String
        inDateStr = inputRow("受注年月")
        
        ' 「20~」と入力されていれば、日付として扱う
        If Len(inDateStr) > 4 And Left(inDateStr, 2) = "20" Then
            
            Dim inDate As Date
            inDate = inputRow("受注年月")
            
            '数値であることの判定後、日付判定
            If inDate <= endDate Then
                Dim tmLeader As String
                tmLeader = convTantou2Leader(inputRow("SK"))
                Dim yyyymm As String
                Dim state As String
                
                If startDate <= inDate And inputRow("確度") <> "D" Then
                    Dim kakudo As String
                    yyyymm = ConvDate2Str(inDate)
                    Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow("千円"))
                
                '前期の確度:A~Cテーマは、未受注テーマとして当期の初月(例:4月)でカウント
                ElseIf inDate < startDate And _
                (inputRow("確度") = "A" Or inputRow("確度") = "B" Or inputRow("確度") = "C") Then
                    yyyymm = ConvDate2Str(startDate)
                    Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow("千円"))
                End If
            
            End If
        End If
    Next
    
    Set CalcJuchuuPlans = summary
End Function

Function CalcJuchuuDones(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        
        Dim inDateStr As String
        inDateStr = inputRow("受注年月")
        
        If Len(inDateStr) > 4 And Left(inDateStr, 2) = "20" And _
           (inputRow("確度") = "受" Or inputRow("確度") = "売") Then
            Dim inDate As Date
            inDate = inDateStr
            
            Dim tmLeader As String
            tmLeader = convTantou2Leader(inputRow("SK"))
            Dim yyyymm As String
            yyyymm = ConvDate2Str(inDate)
            Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow("千円"))
        End If
    Next
    
    Set CalcJuchuuDones = summary
End Function


Function AddPrice2Hash(ByVal summary As Object, _
                       ByVal tmLeader As String, ByVal yyyymm As String, _
                       ByVal newPrice As Integer) As Object
    Dim setKey As String
    setKey = tmLeader & " " & yyyymm
    Dim tmpPrice
    tmpPrice = 0
    If summary.Exists(setKey) Then
        tmpPrice = summary(setKey)
    End If
    
    If IsNumeric(newPrice) Then
        summary(setKey) = tmpPrice + newPrice
    End If
    Set AddPrice2Hash = summary
End Function


Function convTantou2Leader(ByVal tantouName As String) As String
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp") ' 正規表現とキャプチャ
    re.Pattern = "^([^\(\)]+)"
    Dim mc As Object
    Set mc = re.Execute(tantouName)
    If mc.Count > 0 Then
        convTantou2Leader = mc(0)
    Else
        convTantou2Leader = ""
    End If
End Function


'日付型をYYYYMM形式の文字列に変換
Function ConvDate2Str(ByVal orgDate As Date) As String
    Dim dateStr As String
    dateStr = Year(orgDate)
    If month(orgDate) < 10 Then
        dateStr = dateStr & "0" & month(orgDate)
    Else
        dateStr = dateStr & month(orgDate)
    End If
    
    ConvDate2Str = dateStr
End Function


Function ParseInputSheet(ByVal InSheet As Worksheet) As Collection

    Dim atriKeys As Collection
    Set atriKeys = ParseInputThead(InSheet)

    Dim inputRows As Collection
    Set inputRows = ParseInputTbody(InSheet, atriKeys)
    Set ParseInputSheet = inputRows
End Function


Function ParseInputTbody(ByVal InSheet As Worksheet, ByVal atriKeys As Collection) As Collection
    Dim inputRows As Collection
    Set inputRows = New Collection

    Dim rowCo As Integer
    rowCo = 3

    ' テーマ名があるものをloop
    Do While InSheet.Cells(rowCo, 2).Value <> "" And rowCo < 500 'テーマ数の最大値も設定
        Dim inputRow As Object
        Set inputRow = CreateObject("Scripting.Dictionary")
        Dim colCo As Integer
        colCo = 1
        
        Do While colCo < 50 '属性(カラム)の最大数も設定
            If InSheet.Cells(rowCo, colCo).Value <> "" Then
            '全角→半角してhash mapに登録
                inputRow(atriKeys(colCo)) = StrConv(InSheet.Cells(rowCo, colCo).Value, vbNarrow)
            End If
            colCo = colCo + 1
        Loop
        
        ' IsNumeric()は数値であることの判定
        If inputRow.Exists("千円") And IsNumeric(inputRow("千円")) Then
            inputRows.Add inputRow
        Else
            MsgBox "テーマ名:" & inputRow("テーマ名") & " は、受注額が数値以外の入力のようです"
        End If
        rowCo = rowCo + 1
    Loop
    
    Set ParseInputTbody = inputRows
End Function


Function ParseInputThead(ByVal InSheet As Worksheet) As Collection
    Dim atriKeys As Collection    '可変長配列
    Set atriKeys = New Collection
    
    Dim rowCo As Integer
    Dim colCo As Integer
    rowCo = 2
    colCo = 1

    Do While InSheet.Cells(rowCo, colCo).Value <> "" And colCo < 50
        Dim atriKey As String
        atriKey = InSheet.Cells(rowCo, colCo).Value
        
        If IsDate(atriKey) Then '日付の形式チェック
            Dim tmpDate As Date
            tmpDate = atriKey
            atriKey = tmpDate
        End If
    
        atriKeys.Add atriKey
        colCo = colCo + 1
    Loop

    Set ParseInputThead = atriKeys
End Function


Function setSheetFormat(ByVal newSheet As Worksheet) As Integer
    With newSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.31496062992126)
        .RightMargin = Application.InchesToPoints(0.31496062992126)
        .TopMargin = Application.InchesToPoints(0.551181102362205)
        .BottomMargin = Application.InchesToPoints(0.551181102362205)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    setSheetFormat = 1
End Function

'セルの書式(罫線)の設定
Function setTblColFrameLine(ByVal newSheet As Worksheet, _
                            ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                            ByVal colCo As Integer) As Integer
                       
    With newSheet.Range(Cells(rowCo1, colCo), Cells(rowCo2, colCo))
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).ColorIndex = 0
        .Borders(xlEdgeLeft).Weight = xlThin
        
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).ColorIndex = 0
        .Borders(xlEdgeRight).Weight = xlThin
        
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).ColorIndex = 0
        .Borders(xlEdgeTop).Weight = xlThin
        
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = 0
        .Borders(xlEdgeBottom).Weight = xlThin
        
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).ColorIndex = 0
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    
    setTblColFrameLine = rowCo2
End Function

'条件付き書式(データバー)の設定
Function setTblColDatabar(ByVal newSheet As Worksheet, _
                          ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                          ByVal colCo As Integer, _
                          ByVal maxVal As Long, _
                          ByVal barColor As Variant) As Integer
    
    newSheet.Range(Cells(rowCo1, colCo), Cells(rowCo2, colCo)).FormatConditions.AddDatabar
    
    With newSheet.Range(Cells(rowCo1, colCo), Cells(rowCo2, colCo)).FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0
        .MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=maxVal
    
        .barColor.ThemeColor = barColor
        .barColor.TintAndShade = 0.599993896298105
        
        .BarFillType = xlDataBarFillSolid
        .Direction = xlContext
        .NegativeBarFormat.ColorType = xlDataBarColor
        .BarBorder.Type = xlDataBarBorderNone
        .AxisPosition = xlDataBarAxisAutomatic
    End With
    
    setTblColDatabar = rowCo2
End Function

'ワークシートの存在確認
Function ExistWorksheet(ByVal name As String) As Boolean
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.name = name Then
            ExistWorksheet = True
            Exit Function
        End If
    Next
    ExistWorksheet = False
End Function

vbaでクリップボードの値を改行で分割し、それぞれのセルに貼り付け

先程のvbaマクロで、貼付け先のセルが、複数セルを結合したものである場合 結合されたそれぞれのセルに値がsetされるので、更に修正。

Sub AddClickMenu()
  With CommandBars("Cell").Controls.Add(Before:=1)
    .Caption = "値と数値の書式を貼り付け"
    .OnAction = "PasteValAndForm2"
  End With
End Sub

Sub DelClickMenu()
    CommandBars("Cell").Controls("値と数値の書式を貼り付け").Delete
End Sub

Sub PasteValAndForm()
    ActiveWindow.ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub

Sub PasteValAndForm2()

    Dim newVals As Variant
    Dim clippedTxt As String

    ' New MSForms.DataObjectを使用するには、VBAのツールから
    ' 「参照設定」→更に「参照」で C:\Windows\System32\FM20.DLL の追加要
    With New MSForms.DataObject
        .GetFromClipboard    ''変数のデータをDataObjectに格納する
        clippedTxt = .GetText
        newVals = Split(clippedTxt, vbLf)
    End With

    Dim newValsSize As Integer
    newValsSize = UBound(newVals)
    
    Dim col As Integer
    Dim row As Integer
    
    col = ActiveWindow.ActiveCell.Column
    row = ActiveWindow.ActiveCell.row

    Dim i As Integer
    For i = 0 To newValsSize
        ActiveSheet.Cells(row + i, col).Value = newVals(i)
    Next
End Sub

excel vba で右クリックのメニュを追加し、"値と数値の書式"の形式を指定して貼り付け

次のような感じみたい

Sub AddClickMenu()
  With CommandBars("Cell").Controls.Add(Before:=1)
    .Caption = "値と数値の書式を貼り付け"
    .OnAction = "PasteValAndForm"
  End With
End Sub

Sub DelClickMenu()
    CommandBars("Cell").Controls("値と数値の書式を貼り付け").Delete
End Sub


Sub PasteValAndForm()
    ActiveWindow.ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End Sub

改正個人情報保護法の全面施行日は平成29年5月30日

さっき、初めて知りました…

http://www.ppc.go.jp/personal/preparation/

MNISTデータによる手書き数字「0~9」の文字認識 (deep learning & python)

で、先程のエントリに関連して、MNISTデータによる手書き数字「0~9」の文字認識。 というより、これまでと同様の写経。

#!python
# -*- coding: utf-8 -*-
import tensorflow as tf
import numpy as np
import matplotlib.pyplot as plt
from tensorflow.examples.tutorials.mnist import input_data

def main():
    np.random.seed(20170409)

    # MNSIST dataのdownload
    mnist = input_data.read_data_sets("tmp/data/", one_hot=True)


x = tf.placeholder(tf.float32, [None, 784])
    w = tf.Variable(tf.zeros([784, 10]))
    w0 = tf.Variable(tf.zeros([10]))
    f = tf.matmul(x, w) + w0
    p = tf.nn.softmax(f)


    t = tf.placeholder(tf.float32, [None, 10])
    # loss: 誤差関数
    loss = -tf.reduce_sum(t * tf.log(p))
    # train_step: トレーニングアルゴリズム
    train_step = tf.train.AdamOptimizer().minimize(loss)
    # correct_prediction: 予測値と正解値を比較し、正解or notを格納した配列
    # ※1
    correct_prediction = tf.equal(tf.argmax(p, 1), tf.argmax(t, 1))
    # 配列である correct_prediction より、正解率を算出
    accuracy = tf.reduce_mean(tf.cast(correct_prediction, tf.float32))

    
    sess = tf.InteractiveSession()
#    sess.run(tf.initialize_all_variables()) # for tensorflow ver0.1
    sess.run( tf.global_variables_initializer() )

    i = 0
    for _ in range(2000):
        i += 1
        batch_xs, batch_ts = mnist.train.next_batch(100)
        sess.run(train_step, feed_dict={x: batch_xs, t: batch_ts})
        if i % 100 == 0:
            loss_val, acc_val = sess.run([loss, accuracy],
                feed_dict={x:mnist.test.images, t: mnist.test.labels})
            print ('Step: %d, Loss: %f, Accuracy: %f'
                   % (i, loss_val, acc_val))



if __name__ == '__main__':
    main()

↑こう書くと↓こう表示されます

$ python foo_2_4.py 
Extracting tmp/data/train-images-idx3-ubyte.gz
Extracting tmp/data/train-labels-idx1-ubyte.gz
Extracting tmp/data/t10k-images-idx3-ubyte.gz
Extracting tmp/data/t10k-labels-idx1-ubyte.gz
Step: 100, Loss: 7747.077637, Accuracy: 0.848400
Step: 200, Loss: 5439.363281, Accuracy: 0.879900
Step: 300, Loss: 4556.467773, Accuracy: 0.890900
  :
Step: 2000, Loss: 2848.940674, Accuracy: 0.922500
$ 

tf.equal(tf.argmax(p, 1), tf.argmax(t, 1)) の考え方

前回のエントリにもあるように、 正解データであるTのn行目データは、l(エル)番目のみ"1"が登録されています。 (例:"7"の画像である場合、7番目に"1"が登録)

 \displaystyle \large
T_n = 
    \begin{pmatrix}
      t_{1n}  &t_{2n} &\ldots &t_{Kn}
    \end{pmatrix}

予測関数であるPのn行目データは、P1~PKが確率である0~1の値を取ります。 例えば、"7"の画像である可能性が高い場合、P7が1に最も近い値となります。

 \displaystyle \large
P_n = 
    \begin{pmatrix}
      P_1 (x_n)  &P_2 (x_n) &\ldots  &P_K (x_n)
    \end{pmatrix}

tf.argmax()は与えられた配列の中で、最も大きな値を持つ インデックス(配列番号)を返す関数ですので、 tf.equal(tf.argmax(p, 1), tf.argmax(t, 1))とすることで正解 or not を 評価しています。

このように、全データのうち一部を取出しながら、最適化するトレーニングを「ミニバッチ」と呼ぶようです。

3次元超も扱う線形多項分類

以前のエントリで扱った線形多項分類は3次元でしたので、モデルの図示も容易でしたが、 今回は、3次元超も扱える線形多項分類を考えます。

基本となる予測関数とソフトマックス関数

座標:(x1,x2, … , xM)を持つM次空間をK個の領域に分割する予測関数と ソフトマックス関数は次の通り。

 \displaystyle \Large
f_{k} (x_1, x_2, \cdots , x_M) =
  w_{0k} + w_{k1} x_{1} + w_{k2} x_{2} + \cdots + w_{kM} x_{M} \\
  k = 1 , \cdots , M

 \displaystyle \Large
  P_{k} (x_{1}, \cdots ,x_{M}) =
    \frac{ e^{fk(x_{1}, \cdots ,x_{M})}}
         { \sum_{l=1}^{M} e^{fl(x_{1}, \cdots ,x_{M})}}

予測関数とソフトマックス関数を、行列式で表す

N個のトレーニングデータにある

28x28ピクセル(=784次元)の画像に記載された0~9の数値を想定した場合、

M=784, K=10 となり、先程の予測関数は、次の行列式で表せます。

 \displaystyle \large
\underline{ F = X \cdot W \oplus w }

 \displaystyle \large
X = 
    \begin{pmatrix}
      x_{11}  &x_{21}  &\ldots    &x_{M1} \\\
      x_{12}  &x_{22}  &\ldots    &x_{M2} \\\
      \vdots  &\vdots  &\ddots    &\vdots \\\
      x_{1n}  &x_{2N}  &\ldots    &x_{MN}
    \end{pmatrix}

W = 
    \begin{pmatrix}
      w_{11}  &w_{12}  &\ldots    &w_{1K} \\
      w_{21}  &w_{22}  &\ldots    &w_{2K} \\
      \vdots  &\vdots  &\ddots    &\vdots \\
      w_{M1}  &w_{M2}  &\ldots    &w_{MK}
    \end{pmatrix}

 \displaystyle \large
w = ( w_{01} , w_{02} , \ldots , w_{0K} )

 \displaystyle \large
F = 
    \begin{pmatrix}
      f_{1}(x_{1}) &f_{2}(x_{1}) &\ldots &f_{K}(x_{1}) \\\
      f_{1}(x_{2}) &f_{2}(x_{2}) &\ldots &f_{K}(x_{2}) \\\
      \vdots       &\vdots       &\ddots &\vdots \\\
      f_{1}(x_{N}) &f_{2}(x_{N}) &\ldots &f_{K}(x_{N})
    \end{pmatrix}

\hspace{10pt}
f_k (x_n) = w_{0k} + w_{1k} \cdot x_{1n} + \cdots + w_{Mk} \cdot x_{Mn}

となる。

更にこれをソフトマックス関数で表すと、次のようになります。

 \displaystyle \large
P = 
    \begin{pmatrix}
      P_{1}(x_{1}) &P_{2}(x_{1}) &\ldots &P_{K}(x_{1}) \\\
      P_{1}(x_{2}) &P_{2}(x_{2}) &\ldots &P_{K}(x_{2}) \\\
      \vdots       &\vdots       &\ddots &\vdots \\\
      P_{1}(x_{N}) &P_{2}(x_{N}) &\ldots &P_{K}(x_{N})
    \end{pmatrix}
\hspace{10pt}
P_{k} (x_{n}) = \frac { e^{fk(x_{n})} }{ \sum_{l=1}^{K} e^{fl(x_{n})} }

これを更に変形して、n番目(n行目?)の正解を予測する式は次の通り

 \displaystyle \large
P_{n} = \prod_{l=k}^{K}(P_{l}(x_{n}))^{tln}

ここで、tlnは  \displaystyle \large
t_{n} = (0, \cdots, 0,1,0,\cdots, 0)
のように l(エル)番目のみが"1"の行列で、  \displaystyle \large x^{0} = 1 , x^{1} = x の性質を利用しています。

上記のPnは、ある行に限定されたものですので、 これをPの行列全体の確率にするには次の通り

 \displaystyle \large
P = \prod_{n=1}^{N} P_{n} = \prod_{n=1}^{N} \prod_{l=k}^{K}(P_{l}(x_{n}))^{tln}

上記の式は、掛け算が多く、計算効率が低い為、最後に  \displaystyle \large E = - log P の形に変形して完成。

 \displaystyle \large
\underline{
  E = - \sum_{n=1}^{N} \sum_{l=1}^{K} t_{ln} log Pl(x_{n})
}

はてなブログの数式(tex記法)で改行するなら、\\ でなく \\\ (バックスラッシュ3コ)

tex 数式 改行」や「はてなブログ 数式 改行」でググっても、 なかなか見つからないので、メモ

はてなブログででは、今回の改行に関らず、正しいtex記法でも、数式が崩れる場合、 「¥(バックスラッシュ)」でのエスケープや、 <pre> タグで囲む等を 必要とする場合があるようです。

ソフトマックス関数による線形多項分類

前回までのエントリでは、二項分類(パーセプトロン)を扱っていましたが、 今回は、3種以上の分類を行う線形多項分類。

end0tknr.hateblo.jp

基本は、予測関数 f(x1,x2) で形成される平面を考える

今回の線形多項分類では、以下の予測関数 f(x1,x2) と x1, x2, f(x1,x2) により形成される平面を利用します。

 \displaystyle
f(x_1, x_2) = w_0 + w_1 \cdot x_1 + w_2 \cdot x_2

f:id:end0tknr:20170408153449p:plain

3種へ分類する場合、交差する3平面による交点を算出

今回の多項分類では3種に分類しますが、 この分類の為に、交差する3平面による交点を算出します。

f:id:end0tknr:20170408153455p:plain

 \displaystyle
f1(x1, x2) = w01 + w11 \cdot x1 + w21 \cdot x2

 \displaystyle
f2(x1, x2) = w02 + w12 \cdot x1 + w22 \cdot x2

 \displaystyle
f3(x1, x2) = w03 + w13 \cdot x1 + w23 \cdot x2

上記の3平面の交点は、次の連立方程式により求めることができます

 \begin{cases}
   f1(x1, x2) = f2(x1, x2) \\
   f2(x1, x2) = f3(x1, x2)
  \end{cases}

この連立方程式を行列で表すと、次の通り

 \displaystyle
M \cdot \left(
    \begin{array}{c}
      x1 \\
      x2
    \end{array}
  \right)
  = w

 \displaystyle
M = \left(
    \begin{array}{cc}
      w11 - w12 , w21 - w22 \\
      w12 - w13 , w22 - w23
    \end{array}
  \right)
 \displaystyle
w = \left(
    \begin{array}{c}
      w02 - w01 \\
      w03 - w02
    \end{array}
  \right)

よって、3平面の工程は、Mの逆行列により求まります

 \displaystyle
\underline{
\left(
    \begin{array}{c}
      x1 \\
      x2
    \end{array}
  \right)
= M^{-1} \cdot w }

f1(x1,x2), f2(x1,x2) , f3(x1,x2) をソフトマックスにより確率で表現

ある点(x1, x2)が、領域(1)~(3)に属する確率を、 P1(x1,x2), P2(x1,x2), P2(x1,x2) としたとき、 P1(x1,x2) + P2(x1,x2) + P2(x1,x2) = 1 が成立しますが、 これをソフトマックス関数で表すと、次のようになります。

 \displaystyle
Pi(x1,x2) = \frac{ e^{fi(x1,x2)} }{ \sum_{j=1}^{3} e^{fj(x1,x2)} }
   \displaystyle i=1, 2, 3

f:id:end0tknr:20170408153500p:plain

ソフトマックス関数からシグモイド関数を導出

先程のソフトマックス関数までで、線形多項分類の内容は、ほぼ完了ですが、 おまけでソフトマックス関数からシグモイド関数を導出します。

先程のソフトマックス関数において、j=2 のとき、i=1の式は次のようになります。

 \displaystyle
P1(x1,x2) = \frac{ e^{f1(x1,x2)} }{ e^{f1(x1,x2)} + e^{f2(x1,x2)} }

この分母分子を  \displaystyle e^{f1(x1,x2)} で割り、少々、変更すると シグモイド関数を導出できます。  \displaystyle
f1(x1,x2) = \frac{ 1 }{ 1 + e^{f2(x1,x2) - f1(x1,x2)} }

ソフトマックス関数の微分 (導関数)

もう一つおまけで、ソフトマックス関数の微分 (導関数)を記載しておきます。


\frac{dyi}{dxi} =
  \begin{cases}
   yi \cdot (1 - yi)  \leftarrow i=jの場合  \\
   - yi \cdot yj  \leftarrow i≠jの場合  \\
  \end{cases}

以前のエントリでシグモイド関数微分(導関数)の導出を行っていますので、 今回、ソフトマックス関数の微分の導出は記載しません。

end0tknr.hateblo.jp