LoginSignup
1
1

More than 3 years have passed since last update.

Azure ML StudioをExcel-VBAから呼び出してみる

Last updated at Posted at 2019-04-14

Azure ML Studioでアルゴリズムの違いによる予測結果の違いを比べようとして、Azure ML Studioが生成するExcelで比較していましたが、自由にハンドリングしたかったのでExcel-VBAから呼び出すようにしてみました。

Azureの設定について

無償版の設定やwebAPIの制限などちょっとコツがあるようなので、試行錯誤した点を書きます。

1.はじめは既存のダッシュボードから新規(+)→AI + Machine Learningを選択→すべて表示→Machine Learning Studio Workspace を選んで、パラメータを選択と進んだのですが、ワークスペースの価格レベルで標準しか選択できませんでした。

そこでAzure Machine Learningの無償版を利用する (2018.10.22現在)を参考にしてMachine Learning StudioからFree版を作成しました。

この場合、東日本リージョンで Azure ML の提供を開始に記載されているように、無料ワークスペースは米国中南部リージョンで作成されるようです。

2.Free版ではMachine Learning Studio の価格にあるように、実稼働WebAPI(新しいARMベースのAPI)は提供されません。ただしクラシック版のAPI作成は可能です。Free版は、モデルを作成し、REDICTIVE生成して「DEPLOY WEB SERVICE」を押すと(選択肢は無く)クラシック版のAPIが作成されます。標準プランは「DEPLOY WEB SERVICE」を押すとクラシックとNEWの選択が可能です。

※4/15追記:Free版のクラシックAPIの処理も単位時間あたりの制限があります。このVBAでも10件ぐらい処理すると「Request was throttled for Staging endpoint. The maximum concurrency for the endpoint is 0.」とのエラーになるので、1秒ぐらいあけて再トライするようにしました。3万件の処理に9時間掛かりました。標準プランだと20分で終了します。

3.実稼働 Web APIは、価格プランを「DevTest Standard」を選ぶ事で無料になります。「DevTest Standard」は2件までが有効で、3個目を作成すると新しく作成したものが有効になるようです。

Excel-VBA

1.モデルはAzure ML StudioとFlask連携によるWebアプリケーションサンプルで作成したブースティッドデシジョンツリー(NEW)に、デシジョンフォレスト(クラシック)・デシジョンジャングル(クラシック)・ニューラルネットワーク(NEW)を追加しました。

  1. Range("O1")にデータの入力規則の設定でアルゴリズムを切り替えるようにします。

  2. VBAで辞書型を使えるようにする為、ScriptingRuntimeの参照設定が必要です。
    参照設定.jpg

3.(クラシック)か(NEW)でjsonのリクエスト・レスポンスの値の構造が異なります。

{
  "Results": {
    "output1": {
      "type": "DataTable",
      "value": {
        "ColumnNames": [
          "age",
          "workclass",
          "education-num",
          "occupation",
          "race",
          "sex",
          "capital-gain",
          "capital-loss",
          "hours-per-week",
          "native-country",
          "Scored Labels",
          "Scored Probabilities"
        ],
        "ColumnTypes": [
          "Numeric",
          "String",
          "Numeric",
          "String",
          "String",
          "String",
          "Numeric",
          "Numeric",
          "Numeric",
          "String",
          "String",
          "Numeric"
        ],
        "Values": [
          [
            "0",
            "value",
            "0",
            "value",
            "value",
            "value",
            "0",
            "0",
            "0",
            "value",
            "value",
            "0"
          ],
          [
            "0",
            "value",
            "0",
            "value",
            "value",
            "value",
            "0",
            "0",
            "0",
            "value",
            "value",
            "0"
          ]
        ]
      }
    }
  }
}
{
  "ExecutionResults": {
    "Results": {
      "ExecutionOutputs": {
        "output1": [
          {
            "items": {
              "output1Item": {
                "age": "Integer",
                "workclass": "String",
                "education-num": "Integer",
                "occupation": "String",
                "race": "String",
                "sex": "String",
                "capital-gain": "Integer",
                "capital-loss": "Integer",
                "hours-per-week": "Integer",
                "native-country": "String",
                "Scored Labels": "String",
                "Scored Probabilities": "Number"
              }
            }
          }
        ]
      }
    }
  }
}

AzureML.jpg

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub json()
'################################################################
'#
'#
'#
'################################################################

Dim Url, api_key As String

If Range("O1") = "ブースティッドデシジョンツリー" Then
    Url = "https://japaneast.services.azureml.net/subscriptions/4ddef21b07bb41~略"
    api_key = "h/NXP0LLLwwklqkiPh~略"
ElseIf Range("O1") = "デシジョンフォレスト" Then
    Url = "https://ussouthcentral.services.azureml.net/workspaces86a2c1ea93175da9~略"
    api_key = "M4pihqQXhoYR110aEB~略"
ElseIf Range("O1") = "デシジョンジャングル" Then
    Url = "https://ussouthcentral.services.azureml.net/workspaces/86a2c1ea9318430c99e75da993~略"
    api_key = "DuoTIGAEQwFn~略"
Else
    Url = "https://japaneast.services.azureml.net/subscriptions/4ddef21b07bb41559891c93ee~略"
    api_key = "uiRl7dWPLdeN~略"
End If

Range("H1") = Now()
Range("J1") = Now()

Dim i As Double
i = 3

Do While Sheets("Sheet1").Cells(i, 1).Value <> ""
    DoEvents

    'オブジェクトを生成
    Dim JsonObject As Object
    Set JsonObject = New Dictionary

    If Range("O1") = "デシジョンフォレスト" Or Range("O1") = "デシジョンジャングル" Then

        '#クラシックAPI用のjson
        JsonObject.Add "Inputs", New Dictionary
        JsonObject("Inputs").Add "input1", New Dictionary

        JsonObject("Inputs")("input1").Add "ColumnNames", New Collection

        JsonObject("Inputs")("input1")("ColumnNames").Add "age"
        JsonObject("Inputs")("input1")("ColumnNames").Add "workclass"
        JsonObject("Inputs")("input1")("ColumnNames").Add "education-num"
        JsonObject("Inputs")("input1")("ColumnNames").Add "occupation"
        JsonObject("Inputs")("input1")("ColumnNames").Add "race"
        JsonObject("Inputs")("input1")("ColumnNames").Add "sex"
        JsonObject("Inputs")("input1")("ColumnNames").Add "capital-gain"
        JsonObject("Inputs")("input1")("ColumnNames").Add "capital-loss"
        JsonObject("Inputs")("input1")("ColumnNames").Add "hours-per-week"
        JsonObject("Inputs")("input1")("ColumnNames").Add "native-country"

        JsonObject("Inputs")("input1").Add "Values", New Collection

        JsonObject("Inputs")("input1")("Values").Add New Collection

        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 1).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 2).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 3).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 4).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 5).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 6).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 7).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 8).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 9).Value
        JsonObject("Inputs")("input1")("Values")(1).Add Sheets("Sheet1").Cells(i, 10).Value

        JsonObject.Add "GlobalParameters", New Dictionary

    Else
        JsonObject.Add "Inputs", New Dictionary
        JsonObject("Inputs").Add "input1", New Collection

        JsonObject("Inputs")("input1").Add New Dictionary

        JsonObject("Inputs")("input1")(1).Add "age", Sheets("Sheet1").Cells(i, 1).Value
        JsonObject("Inputs")("input1")(1).Add "workclass", Sheets("Sheet1").Cells(i, 2).Value
        JsonObject("Inputs")("input1")(1).Add "education-num", Sheets("Sheet1").Cells(i, 3).Value
        JsonObject("Inputs")("input1")(1).Add "occupation", Sheets("Sheet1").Cells(i, 4).Value
        JsonObject("Inputs")("input1")(1).Add "race", Sheets("Sheet1").Cells(i, 5).Value
        JsonObject("Inputs")("input1")(1).Add "sex", Sheets("Sheet1").Cells(i, 6).Value
        JsonObject("Inputs")("input1")(1).Add "capital-gain", Sheets("Sheet1").Cells(i, 7).Value
        JsonObject("Inputs")("input1")(1).Add "capital-loss", Sheets("Sheet1").Cells(i, 8).Value
        JsonObject("Inputs")("input1")(1).Add "hours-per-week", Sheets("Sheet1").Cells(i, 9).Value
        JsonObject("Inputs")("input1")(1).Add "native-country", Sheets("Sheet1").Cells(i, 10).Value

    End If


    ' イミディエイトウィンドウで確認(デバック用)
    Debug.Print JsonConverter.ConvertToJson(JsonObject, Whitespace:=2)

    Dim objHTTP, jsonObj As Object
    Set objHTTP = CreateObject("msxml2.xmlhttp")

    objHTTP.Open "POST", Url, False
    objHTTP.setRequestHeader "Content-Type", "application/json"
    objHTTP.setRequestHeader "Authorization", "Bearer " & api_key
    objHTTP.send JsonConverter.ConvertToJson(JsonObject)

    ' レスポンスコード(正常)
    If objHTTP.Status = 200 Then

        Set jsonObj = JsonConverter.ParseJson(objHTTP.responseText)

        If Range("O1") = "ブースティッドデシジョンツリー" Then
            Sheets("Sheet1").Cells(i, 12).Value = jsonObj("Results")("output1")(1)("Scored Labels")
        ElseIf Range("O1") = "デシジョンフォレスト" Then
            Sheets("Sheet1").Cells(i, 14).Value = jsonObj("Results")("output1")("value")("Values")(1)(11)
        ElseIf Range("O1") = "デシジョンジャングル" Then
            Sheets("Sheet1").Cells(i, 16).Value = jsonObj("Results")("output1")("value")("Values")(1)(11)
        Else
            Sheets("Sheet1").Cells(i, 18).Value = jsonObj("Results")("output1")(1)("Scored Labels")
        End If
    Else
        Set jsonObj = JsonConverter.ParseJson(objHTTP.responseText)
        MSG1 = jsonObj("error")("details")(1)("message")

        If MSG1 = "Request was throttled for Staging endpoint. The maximum concurrency for the endpoint is 0." Then
            Sleep 1000   'ミリ秒指定
        Else
            MsgBox ("エラーです :" & objHTTP.responseText)
            Exit Do
        End If
    End If
   i = i + 1
   Range("E1") = i

Loop

Range("J1") = Now()
MsgBox ("終了です")
End Sub

4.REST通信やJSONのデータ作成については、このサイトを参考にしました。
リクエストのJSON作成・戻ったレスポンスから目的の値を取り出す定義が、ちょっと試行錯誤してしまいましたが、いったんわかればExcelから自由に入力を与えて戻り値も自由にプロットできるので分析などに便利かと思います。

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1