Results tagged “scriptolympics2008” from PHactotum Wheneverly

Event 4: Image is Everything

|

Here is my submission for the Advanced Event 4 in the Microsoft Scripting Games 2008.

   1: '*********************************************************************

   2: ' Script Name: Event4.vbs

   3: '     Version: 1.1

   4: '      Author: Perry Harris (PHactotum)

   5: '     Updated: 1:30 AM Friday, February 22, 2008

   6: '     Purpose: Solves the 2008 winter Scripting Games Advance Event 4: Image is Everything

   7: '              

   8: '       Usage: cscript Event4.vbs

   9: '       Notes:

  10: '    Keywords: 

  11: '  versioning: 1.0  Original release

  12: '              1.1  Modified to put lines in our calendar using + - and |

  13: '*********************************************************************

  14: Option Explicit

  15: Dim intYear, i, intMonth

  16: Dim strText

  17: Dim StartDate, EndDate, CurrDate

  18: Dim intLeft, intRight

  19: Dim a

  20:  

  21: 'Get the desired Month and Year for the Calendar

  22: WScript.StdOut.Write "Please enter Month/Year using numeric digits: "

  23: strText = WScript.StdIn.ReadLine

  24:  

  25: 'Assuming the user used a / as the separator

  26: a = split(strText,"/")

  27: intMonth = a(0)

  28: intYear = a(1)

  29:  

  30: 'Start our Calendar on the first day of the given month and year

  31: StartDate = DateSerial(intYear,intMonth,1)

  32: EndDate = DateSerial(Year(DateAdd("m",1,StartDate)),Month(DateAdd("m",1,StartDate)),1)

  33:  

  34: 'Write Top border

  35: WScript.StdOut.Write chr(43)

  36: WScript.StdOut.Write string(41,chr(45))

  37: WScript.StdOut.WriteLine chr(43)

  38:  

  39: 'Write out our Month and Year

  40: WScript.StdOut.Write chr(124)

  41: intLeft = (41 - Len(MonthName(intMonth) & " " & Year(StartDate))) /2

  42: intRight = 41 - Len(MonthName(intMonth) & " " & Year(StartDate)) - intLeft

  43: WScript.StdOut.Write space(intLeft)

  44: WScript.StdOut.Write MonthName(intMonth) & " " & Year(StartDate)

  45: WScript.StdOut.Write space(intRight)

  46: WScript.StdOut.WriteLine chr(124)

  47: WScript.StdOut.WriteLine chr(124) & space(41) & chr(124)

  48:  

  49: 'Yes, we could have used a function for these three lines seeing as we use them repeatedly

  50: WScript.StdOut.Write chr(43)

  51: WScript.StdOut.Write string(41,chr(45))

  52: WScript.StdOut.WriteLine chr(43)

  53:  

  54:  

  55: 'Write out our days of the week tab separated and in abbreviated form

  56: For i = 1 to 7

  57:     WScript.StdOut.Write chr(124) & space(1) & WeekDayName(i,True) & space(1)

  58: next

  59: WScript.StdOut.WriteLine chr(124)

  60: 'And again these three lines

  61: WScript.StdOut.Write chr(43)

  62: WScript.StdOut.Write string(41,chr(45))

  63: WScript.StdOut.WriteLine chr(43)

  64:  

  65:  

  66:  

  67: 'Pad the first week

  68: i = 0

  69: While i < Weekday(StartDate) - 1

  70:     WScript.StdOut.Write chr(124) & space(5)

  71:     i = i + 1

  72: wend

  73:  

  74: 'Print The Days

  75: CurrDate = StartDate

  76: While CurrDate < EndDate    

  77:     If Weekday(CurrDate) = 7 then 

  78:         WScript.StdOut.WriteLine Chr(124) & LeftPad(Day(CurrDate),4) & space(1) & chr(124)

  79:     else

  80:         WScript.StdOut.Write chr(124) & LeftPad(day(CurrDate),4) & space(1)

  81:     end if

  82:     CurrDate = DateAdd("d",1,CurrDate)

  83: Wend

  84:  

  85: 'Pad the last week

  86: If Weekday(CurrDate) > 1 then ' If we are at 1, we don't want to print a blank row

  87: While Weekday(CurrDate) < 7

  88:         WScript.StdOut.Write chr(124) & space(5)

  89:     CurrDate = DateAdd("d",1,CurrDate)

  90: wend

  91: WScript.StdOut.WriteLine chr(124) & space(5) & chr(124)

  92: end if

  93:  

  94: 'One more time

  95: WScript.StdOut.Write chr(43)

  96: WScript.StdOut.Write string(41,chr(45))

  97: WScript.StdOut.WriteLine chr(43)

  98:  

  99:  

 100:  

 101: 'This is used to right justify the dates under the three letter abbreviations for the days of the week.

 102: Function LeftPad(strText,intWidth)

 103:     LeftPad = Space(intWidth - Len(strText)) & strText

 104: end function


 

I spent a little extra time on this one.  I had a calendar that looked just like their example:



C:\scripts>cscript Event4-1.vbs
Please enter Month/Year using numeric digits: 2/2008
February 2008

Sun Mon Tue Wed Thu Fri Sat
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29
C:\scripts>


 

But I thought I'd like to take it up a notch.  I like calendars with grid lines:

C:\scripts>cscript Event4.vbs
Please enter Month/Year using numeric digits: 2/2008
+-----------------------------------------+
|              February 2008              |
|                                         |
+-----------------------------------------+
| Sun | Mon | Tue | Wed | Thu | Fri | Sat |
+-----------------------------------------+
|     |     |     |     |     |   1 |   2 |
|   3 |   4 |   5 |   6 |   7 |   8 |   9 |
|  10 |  11 |  12 |  13 |  14 |  15 |  16 |
|  17 |  18 |  19 |  20 |  21 |  22 |  23 |
|  24 |  25 |  26 |  27 |  28 |  29 |     |
+-----------------------------------------+

Event 3: Instant (Runoff) Winner

|

Here is my submission for the Advanced Event 3 in the Microsoft Scripting Games 2008.

 

   1: '*********************************************************************

   2: ' Script Name: Event3.vbs

   3: '     Version: 1.0

   4: '      Author: Perry Harris (PHactotum)

   5: '     Updated: 9:49 PM Thursday, February 21, 2008

   6: '     Purpose: Solves the 2008 winter Scripting Games Advance Event 3: Instant (Runoff) Winner

   7: '              

   8: '       Usage: cscript Event3.vbs [phone number]

   9: '       Notes:

  10: '    Keywords: 

  11: '  versioning: 1.0    Original release

  12: '*********************************************************************

  13: Option Explicit

  14: Dim Politicians, Losers, Candidate

  15: Dim Done

  16: Dim objFS, objFile

  17: Dim strLine

  18: Dim aVote

  19: Dim i

  20: Dim LowestVote

  21: Dim LowestName

  22: Dim TotalVotes

  23:  

  24: Const ForReading = 1

  25: 'We'll be using two Dictionaries to keep track of our Politicians and our Losers.

  26: set Politicians=CreateObject("Scripting.Dictionary")

  27: set Losers=CreateObject("Scripting.Dictionary")

  28:  

  29: 'Open and read our Voting File

  30: Set objFS = CreateObject("Scripting.FileSystemObject")

  31: 'Just to be clear, We're not done yet

  32: Done = False

  33:  

  34: Do 

  35:     Politicians.RemoveAll

  36:     TotalVotes = 0

  37:     Set objFile = objFS.OpenTextFile("C:\Scripts\votes.txt", ForReading)

  38:     Do until objFile.AtEndOfStream

  39:         strLine = objFile.ReadLine

  40:         aVote = split(strLine,",")

  41:         i = 0

  42:         Do until not(Losers.Exists(aVote(i)))

  43:             i = i + 1

  44:         loop

  45:         

  46:         If Politicians.Exists(aVote(i)) then

  47:             Politicians.Item(aVote(i)) = Politicians.Item(aVote(i)) + 1

  48:         else

  49:             Politicians.Add aVote(i), 1

  50:         end if

  51:         TotalVotes = TotalVotes + 1

  52:     Loop

  53:     'Debugging statement

  54:     'WScript.StdOut.WriteLine "============================="

  55:     'We set LowestVote to 100%, or 1.00 so that as we find lower numbers we bubble down to the lowest result for possible extra passes.

  56:     LowestVote = 1

  57:     LowestName = "" 'Just to make sure it doesn't affect the outcome in future passes

  58:     For each Candidate in Politicians

  59:         'The following line was used for debugging purposes

  60:         'Wscript.StdOut.WriteLine Candidate & ": " & FormatPercent(Politicians.Item(Candidate)/TotalVotes,1)

  61:         If Politicians.Item(Candidate)/TotalVotes > 0.5 then

  62:             WScript.StdOut.WriteLine "The winner is " & Candidate & " with " & FormatPercent(Politicians.Item(Candidate)/TotalVotes,1) & " of the vote."

  63:             Done = True

  64:             Exit For

  65:         else if LowestVote > Politicians.Item(Candidate)/TotalVotes then

  66:             LowestName = Candidate

  67:             LowestVote = Politicians.Item(Candidate)/TotalVotes

  68:             end if

  69:         end if

  70:     next

  71:     Losers.Add LowestName,LowestVote 'Really don't need the vote but the Dictionary add method requires an item.

  72:     objFile.Close

  73: Loop Until Done


Event 2: Skating on Thin Ice

|

Here is my submission for the Advanced Event 2 in the Microsoft Scripting Games 2008

   1: '*********************************************************************

   2: ' Script Name: Event2.vbs

   3: '     Version: 1.0

   4: '      Author: Perry Harris (PHactotum)

   5: '     Updated: 1:25 AM Wednesday, February 20, 2008

   6: '     Purpose: Solves the 2008 winter Scripting Games Advance Event 2: Skating on Thin Ice

   7: '              

   8: '       Usage: cscript Event2.vbs [phone number]

   9: '       Notes:

  10: '    Keywords: 

  11: '  versioning: 1.0    Original release

  12: '*********************************************************************

  13: Option Explicit

  14: Const ForReading = 1

  15: Dim objFS

  16: Dim objFile

  17: Dim strLine

  18: Dim aScore

  19: Dim i

  20: Dim ScoreMax, ScoreMin,ScoreTotal,ScoreAvg

  21: Dim GoldScore, GoldName

  22: Dim SilverScore, SilverName

  23: Dim BronzeScore, BronzeName

  24: GoldScore = 0

  25: SilverScore = 0

  26: BronzeScore = 0

  27: GoldName = ""

  28: SilverName = ""

  29: BronzeName = ""

  30:  

  31: 'Open and read our WordList

  32: Set objFS = CreateObject("Scripting.FileSystemObject")

  33: Set objFile = objFS.OpenTextFile("C:\Scripts\Skaters.txt", ForReading)

  34:  

  35: Do until objFile.AtEndOfStream

  36:     strLine = objFile.ReadLine

  37:     aScore = split(strLine,",")

  38:     ScoreMax = aScore(1)

  39:     ScoreMin = aScore(1)

  40:     ScoreTotal = 0

  41:     for i = 1 to ubound(aScore)

  42:         If aScore(i) > ScoreMax then ScoreMax = aScore(i)

  43:         If aScore(i) < ScoreMin then ScoreMin = aScore(i)

  44:         ScoreTotal = ScoreTotal + aScore(i)

  45:     next

  46:     ScoreTotal = ScoreTotal - ScoreMax - ScoreMin

  47:     ScoreAvg = ScoreTotal / (uBound(aScore)-2)

  48:     

  49:     If ScoreAvg > GoldScore then

  50:         BronzeName = SilverName

  51:         BronzeScore = SilverScore

  52:         SilverName = GoldName

  53:         SilverScore = GoldScore

  54:         GoldName = aScore(0)

  55:         GoldScore = ScoreAvg

  56:     Else If ScoreAvg > SilverScore then

  57:         BronzeName = SilverName

  58:         BronzeScore = SilverScore

  59:         SilverName = aScore(0)

  60:         SilverScore = ScoreAvg

  61:         Else If ScoreAvg > BronzeScore then

  62:             BronzeName = aScore(0)

  63:             BronzeScore = ScoreAvg

  64:             end if

  65:         end if

  66:     end if

  67:     

  68: Loop

  69: Wscript.StdOut.WriteLine "Gold medal: " & GoldName & ", " & GoldScore

  70: Wscript.StdOut.WriteLine "Silver medal: " & SilverName & ", " & SilverScore

  71: Wscript.StdOut.WriteLine "Bronze medal: " & BronzeName & ", " & BronzeScore


Event 1: Could I get your Phone Number?

|

Here is my submission for the Advanced Event 1 in the Microsoft Scripting Games 2008

   1: '*********************************************************************

   2: ' Script Name: Event1.vbs

   3: '     Version: 1.0

   4: '      Author: Perry Harris (PHactotum)

   5: '     Updated: 12:04 AM Wednesday, February 20, 2008

   6: '     Purpose: Solves the 2008 winter Scripting Games Advance Event 1: Could I get your Phone Number?

   7: '              

   8: '       Usage: cscript Event1.vbs [phone number]

   9: '       Notes:

  10: '    Keywords: 

  11: '  versioning: 1.0    Original release

  12: '*********************************************************************

  13: Option Explicit

  14: Dim strNumber

  15: Dim colMatches

  16: Dim objRegEx

  17: Dim Nums

  18: Dim objFS

  19: Dim objFile

  20: Dim strAll

  21: Dim i

  22: Const ForReading = 1

  23:  

  24: ' Retreive our phone number

  25: if WScript.Arguments.Count < 1 then

  26:     WScript.StdOut.Write "Please enter a 7 digit phone number: "

  27:     strNumber = WScript.StdIn.ReadLine

  28: else

  29:     strNumber = WScript.Arguments(0)

  30: end if

  31:  

  32: 'Verify our phone number is 7 digits and only uses the digits 2 - 9

  33: Set objRegEx = CreateObject("VBScript.RegExp")

  34: objRegEx.Pattern = "[2-9]{7}"

  35: Set colMatches = objRegEx.Execute(strNumber)

  36: if colMatches.Count <> 1 then

  37:     WScript.StdOut.WriteLine "I'm sorry, we only accept 7 digit numbers using the numbers 2 - 9."

  38:     WScript.StdOut.WriteLine "Please try again."

  39:     WScript.Quit

  40: end if

  41:  

  42: 'Convert our phone number to a regular expression

  43: set Nums=CreateObject("Scripting.Dictionary")

  44: Nums.Add 2, "[aAbBcC]"

  45: Nums.Add 3, "[dDeEfF]"

  46: Nums.Add 4, "[gGhHiI]"

  47: Nums.Add 5, "[jJkKlL]"

  48: Nums.Add 6, "[mMnNoO]"

  49: Nums.Add 7, "[pPrRsS]"

  50: Nums.Add 8, "[tTuUvV]"

  51: Nums.Add 9, "[wWxXyY]"

  52:  

  53: for i = 2 to 9

  54:     strNumber = replace(strNumber,i,Nums.item(i))

  55: next

  56:  

  57: objRegEx.Pattern = strNumber & "\r\n"

  58:  

  59: 'Open and read our WordList

  60: Set objFS = CreateObject("Scripting.FileSystemObject")

  61: Set objFile = objFS.OpenTextFile("C:\Scripts\wordlist.txt", ForReading)

  62:  

  63: strAll = objFile.Readall

  64:  

  65: 'Now let's see if there is a match in our word list

  66: Set colMatches = objRegEx.Execute(strAll)  

  67:  

  68: If colMatches.Count > 0 Then

  69:     Wscript.StdOut.WriteLine colMatches(0)

  70: else

  71:     WScript.StdOut.WriteLine "Sorry, no Matches were found"

  72: End If


Microsoft Scripting Olympics

|

Sounds like fun.  I think I'll try this.  I've looked over the events and they look doable.  The schedule might be tight, as the last entries are due on the first day of DEC2008, but we'll see.

I may even post my submissions here.

April 2017

Sun Mon Tue Wed Thu Fri Sat
            1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30            

Find recent content on the main index or look in the archives to find all content.

Archives