13歲的小明喜歡玩他的方塊積木，他總是把方塊疊在一起，型成高度不一的方塊堆。然後他說：這是一面牆。五歲的妹妹小每聽到了就跟小明說：真正的牆高度應該要一樣才行。小明聽了覺得有道理，於是決定要搬動一些方塊使所有方塊堆的高度一樣。如下圖。由於小明是個懶惰的小孩，他想要搬動最小數目的方塊，以達成這個目的，你能幫助他嗎？ （輸入規範：每組資料有兩列 第一列有一個數字Ｎ，代表有幾堆方塊，第二列有ｎ個數字，分別代表這Ｎ堆方塊的高度Ｈ。另１<=n<=50、1<=H<=100。方塊的總數一定可以整除堆數Ｎ，也就是說，一定可以使所有方塊同高度。）
▉
▉
▉ ▉▉ →
▉ ▉ ▉▉ ▉▉▉▉▉▉
▉ ▉ ▉▉ ▉▉▉▉▉▉
▉▉▉ ▉▉ ▉▉▉▉▉▉
▉▉▉▉▉▉ ▉▉▉▉▉▉
輸入範例：
６
５ ２ ４ １ ７ ５
輸出範例：
５
參照 http://chscvb.blogspot.com/2010/02/20100204.html
Dim N As Integer '堆數
回覆刪除Dim H(50) As Integer '高度
Dim Total As Integer '總個數
Dim HT As Integer '平均高度
Dim Ans As Integer '移動次數
Private Sub Form_Load()
Me.Hide
Open App.Path & "\in.txt" For Input As #1
Input #1, N
For i = 1 To N
Input #1, H(i)
Next i
Close #1
For i = 1 To N
Total = Total + H(i)
Next i
HT = Total / N
For i = 1 To N
If H(i) > HT Then Ans = Ans + (H(i) - HT)
Next i
Open App.Path & "\out.txt" For Output As #2
Print #2, Ans
Close #2
End
End Sub
Dim a(100) As Integer, tmp As Integer
回覆刪除Private Sub Form_Load()
Me.Hide
Open App.Path & "/in.txt" For Input As #1
Open App.Path & "/out.txt" For Output As #2
Input #1, n
If n > 50 Or n < 0 Then GoTo bye
For i = 1 To n
Input #1, a(i)
sums = sums + a(i)
Next
moest = sums / n
Do
If a(i) > moest Then a(i) = a(i) - (a(i) - moest): tmp = a(i) - moest: times = times + 1
If a(i) < moest Then a(i) = a(i) + Abs(tmp - moest): tmp = Abs(tmp - moest)
If a(i) = moest Then succed = succed + 1
If i < n Then i = i + 1 Else i = 0: succed = 0
Loop Until succed = n
Print #2, times
Close #2
Close #1
bye:
End
End Sub
-----------------------
我一開始想說 要等到哪時才會有人寫好
我貼這篇的時候已經寫好了呢
等得還蠻久的 =D
佑，arro好，
回覆刪除佑的程式正確，除了第二個迴圈可以像arro寫在第一個迴圈。
而arro的do迴圈寫的很亂，沒什麼必要性。
這題看懂題目後，是簡單的，別想那麼複雜。
熊掌
Private Sub Form_Load()
回覆刪除Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Input #1, Cout
Do Until EOF(1)
Input #1, n
Sum = Sum + n
Loop
aver = Sum / Cout
Close #1
Open App.Path & "\in.txt" For Input As #1
Input #1, Cout
Do Until EOF(1)
Input #1, n
If n > aver Then
total = total - (aver - n)
Else
total = total + (aver - n)
End If
Loop
Print #2, total / 2
Close #1
Close #2
End
End Sub
Jimmer好，
回覆刪除程式正確。
但是，最後那個else是多餘的。
熊掌
Private Sub Form_Load()
回覆刪除Me.Hide
Open App.Path & "\in.txt" For Input As #1
Open App.Path & "\out.txt" For Output As #2
Input #1, t
Line Input #1, n
Call A1(t, n)
Close
Close
End
End Sub
Sub A1(a, b)
Dim s, p%, ans%
s = Split(b)
For i = 0 To UBound(s)
p = p + s(i)
Next
p = p / a
For i = 0 To UBound(s)
If s(i) > p Then ans = ans + (s(i) - p)
Next
Print #2, ans
End Sub
2:06